Session Pi_Calculus

Theory Agent

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Agent
  imports "HOL-Nominal.Nominal"
begin

lemma pt_id:
  fixes x :: 'a
    and a :: 'x

  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)"
  shows "[(a, a)]  x = x"
proof -
  have "x = ([]::'x prm)  x"
    by(simp add: pt1[OF pt])
  also have "[(a, a)]  x = ([]::'x prm)  x"
    by(simp add: pt3[OF pt] at_ds1[OF at])
  finally show ?thesis by simp
qed

lemma pt_swap:
  fixes x :: 'a
  and a :: 'x
  and b :: 'x

  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)"

  shows "[(a, b)]  x = [(b, a)]  x"
proof -
  show ?thesis by(simp add: pt3[OF pt] at_ds5[OF at])
qed

atom_decl name

lemmas name_fresh_abs = fresh_abs_fun_iff[OF pt_name_inst, OF at_name_inst, OF fs_name1]
lemmas name_bij = at_bij[OF at_name_inst]
lemmas name_supp_abs = abs_fun_supp[OF pt_name_inst, OF at_name_inst, OF fs_name1]
lemmas name_abs_eq = abs_fun_eq[OF pt_name_inst, OF at_name_inst]
lemmas name_supp = at_supp[OF at_name_inst]
lemmas name_calc = at_calc[OF at_name_inst]
lemmas name_fresh_fresh = pt_fresh_fresh[OF pt_name_inst, OF at_name_inst]
lemmas name_fresh_left = pt_fresh_left[OF pt_name_inst, OF at_name_inst]
lemmas name_fresh_right = pt_fresh_right[OF pt_name_inst, OF at_name_inst]
lemmas name_id[simp] = pt_id[OF pt_name_inst, OF at_name_inst]
lemmas name_swap_bij[simp] = pt_swap_bij[OF pt_name_inst, OF at_name_inst]
lemmas name_swap = pt_swap[OF pt_name_inst, OF at_name_inst]
lemmas name_rev_per = pt_rev_pi[OF pt_name_inst, OF at_name_inst]
lemmas name_per_rev = pt_pi_rev[OF pt_name_inst, OF at_name_inst]
lemmas name_exists_fresh = at_exists_fresh[OF at_name_inst, OF fs_name1]
lemmas name_perm_compose = pt_perm_compose[OF pt_name_inst, OF at_name_inst]

nominal_datatype pi = PiNil                  ("𝟬")
                    | Output name name pi    ("_{_}._" [120, 120, 110] 110)
                    | Tau pi                 ("τ._" [120] 110)
                    | Input name "«name» pi" ("_<_>._" [120, 120, 110] 110)
                    | Match name name pi     ("[__]_" [120, 120, 110] 110)
                    | Mismatch name name pi  ("[__]_" [120, 120, 110] 110)
                    | Sum pi pi              (infixr "" 90)
                    | Par pi pi              (infixr "" 85)
                    | Res "«name» pi"        ("_>_" [100, 100] 100)
                    | Bang pi                ("!_" [110] 110)

lemmas name_fresh[simp] = at_fresh[OF at_name_inst]

lemma alphaInput:
  fixes a :: name
  and   x :: name
  and   P :: pi
  and   c :: name

  assumes A1: "c  P"

  shows "a<x>.P = a<c>.([(x, c)]  P)"
proof(cases "x = c")
  assume "x=c"
  thus ?thesis by(simp)
next
  assume "x  c"
  with A1 show ?thesis
    by(simp add: pi.inject alpha name_fresh_left name_calc)
qed

lemma alphaRes:
  fixes a :: name
  and   P :: pi
  and   c :: name
  
  assumes A1: "c  P"

  shows "a>P = c>([(a, c)]  P)"
proof(cases "a=c")
  assume "a=c"
  thus ?thesis by simp
next
  assume "a  c"
  with A1 show ?thesis
    by(simp add: pi.inject alpha fresh_left name_calc)
qed

(*Substitution*)

definition subst_name :: "name  name  name  name"   ("_[_::=_]" [110, 110, 110] 110)
where
  "a[b::=c]  if (a = b) then c else a"

declare subst_name_def[simp]

lemma subst_name_eqvt[eqvt]:
  fixes p :: "name prm"
  and   a :: name
  and   b :: name
  and   c :: name

  shows "p  (a[b::=c]) = (p a)[(p  b)::=(p  c)]"
by(auto simp add: at_bij[OF at_name_inst])


nominal_primrec (freshness_context: "(c::name, d::name)")
  subs :: "pi  name  name  pi" ("_[_::=_]" [100,100,100] 100)
where
  "𝟬[c::=d] = 𝟬"
| "τ.(P)[c::=d] = τ.(P[c::=d])"
| "a{b}.P[c::=d] = (a[c::=d]){(b[c::=d])}.(P[c::=d])"
| "x  a; x  c; x  d  (a<x>.P)[c::=d] = (a[c::=d])<x>.(P[c::=d])"
| "[ab]P[c::=d] = [(a[c::=d])(b[c::=d])](P[c::=d])"
| "[ab]P[c::=d] = [(a[c::=d])(b[c::=d])](P[c::=d])"
| "(P  Q)[c::=d] = (P[c::=d])  (Q[c::=d])"
| "(P  Q)[c::=d] = (P[c::=d])  (Q[c::=d])"
| "x  c; x  d  (x>P)[c::=d] = x>(P[c::=d])"
| "!P[c::=d] = !(P[c::=d])"
apply(simp_all add: abs_fresh)
apply(finite_guess)+
by(fresh_guess)+

lemma forget:
  fixes a :: name
  and   P :: pi
  and   b :: name

  assumes "a  P"

  shows "P[a::=b] = P"
using assms
by(nominal_induct P avoiding: a b rule: pi.strong_induct)
  (auto simp add: name_fresh_abs)

lemma fresh_fact2[rule_format]:
  fixes P :: pi
  and   a :: name
  and   b :: name

  assumes "a  b"

  shows "a  P[a::=b]"
using assms
by(nominal_induct P avoiding: a b rule: pi.strong_induct)
  (auto simp add: name_fresh_abs)

lemma subst_identity[simp]:
  fixes P :: pi
  and   a :: name

  shows "P[a::=a] = P"
by(nominal_induct P avoiding: a rule: pi.strong_induct) auto

lemma renaming:
  fixes P :: pi
  and   a :: name
  and   b :: name
  and   c :: name

  assumes "c  P"

  shows "P[a::=b] = ([(c, a)]  P)[c::=b]"
using assms
by(nominal_induct P avoiding: a b c rule: pi.strong_induct)
  (auto simp add: name_calc name_fresh_abs)


lemma fresh_fact1:
  fixes P :: pi
  and   a :: name
  and   b :: name
  and   c :: name

  assumes "a  P"
  and     "a  c"

  shows "a  P[b::=c]"
using assms
by(nominal_induct P avoiding: a b c rule: pi.strong_induct)
  (auto simp add: name_fresh_abs)


lemma eqvt_subs[eqvt]:
  fixes p :: "name prm"
  and   P :: pi
  and   a :: name
  and   b :: name

  shows "p  (P[a::=b]) = (p  P)[(p  a)::=(p  b)]"
by(nominal_induct P avoiding: a b rule: pi.strong_induct)
  (auto simp add: name_bij)


lemma substInput[simp]:
  fixes x :: name
  and   b :: name
  and   c :: name
  and   a :: name
  and   P :: pi

  assumes "x  b"
  and     "x  c"

  shows "(a<x>.P)[b::=c] = (a[b::=c])<x>.(P[b::=c])"
proof -
  obtain y::name where"y  a" and "y  P" and "y  b" and "y  c"
    by(generate_fresh "name") (auto simp add: fresh_prod)
  from y  P have "a<x>.P = a<y>.([(x, y)]  P)" by(simp add: alphaInput)
  moreover have "(a[b::=c])<x>.(P[b::=c]) = (a[b::=c])<y>.(([(x, y)]  P)[b::=c])" (is "?LHS = ?RHS")
  proof -
    from y  P y  c have "y  P[b::=c]" by(rule fresh_fact1)
    hence "?LHS = (a[b::=c])<y>.([(x, y)]  (P[b::=c]))" by(simp add: alphaInput)
    moreover with x  b x  c y  b y  c have " = ?RHS"
      by(auto simp add: eqvt_subs name_calc)
    ultimately show ?thesis by simp
  qed
  ultimately show ?thesis using y  a y  b y  c by simp
qed

lemma injPermSubst:
  fixes P :: pi
  and   a :: name
  and   b :: name

  assumes "b  P"

  shows "[(a, b)]  P = P[a::=b]"
using assms
by(nominal_induct P avoiding: a b rule: pi.strong_induct)
  (auto simp add: name_calc name_fresh_abs)

lemma substRes2:
  fixes P :: pi
  and   a :: name
  and   b :: name

  assumes "b  P"

  shows "a>P = b>(P[a::=b])"
proof(case_tac "a = b")
  assume "a = b"
  thus ?thesis by auto
next
  assume "a  b"
  moreover with b  P show ?thesis
    apply(simp add: pi.inject abs_fun_eq[OF pt_name_inst, OF at_name_inst])
    apply auto
    apply(simp add: renaming)
    apply(simp add: pt_swap[OF pt_name_inst, OF at_name_inst])
    apply(simp add: renaming)
    apply(simp add: pt_fresh_left[OF pt_name_inst, OF at_name_inst])
    by(force simp add: at_calc[OF at_name_inst])
qed

lemma freshRes:
  fixes P :: pi
  and   a :: name
  
  shows "a  a>P"
by(simp add: name_fresh_abs)

lemma substRes3: 
  fixes P :: pi
  and   a :: name
  and   b :: name

  assumes "b  P"

  shows "(a>P)[a::=b] = b>(P[a::=b])"
proof -
  have "(a>P)[a::=b] = a>P"
    using freshRes by(simp add: forget)
  thus ?thesis using b  P by(simp add: substRes2)
qed

lemma suppSubst:
  fixes P :: pi
  and   a :: name
  and   b :: name

  shows "supp(P[a::=b])  insert b ((supp P) - {a})"
apply(nominal_induct P avoiding: a b rule: pi.strong_induct,
      simp_all add: pi.supp name_supp_abs name_supp supp_prod)
by(blast)+
  
(******** Sequential substitution *******)

primrec seqSubs :: "pi  (name × name) list  pi" ("_[<_>]" [100,100] 100) where
  "P[<[]>] = P"
| "P[<(x#σ)>] = (P[(fst x)::=(snd x)])[<σ>]"

primrec seq_subst_name :: "name  (name × name) list  name" where
  "seq_subst_name a [] = a"
| "seq_subst_name a (x#σ) = seq_subst_name (a[(fst x)::=(snd x)]) σ"

lemma freshSeqSubstName:
  fixes x :: name
  and   a :: name
  and   s :: "(name × name) list"

  assumes "x  a"
  and     "x  s"

  shows "x  seq_subst_name a s"
using assms
apply(induct s arbitrary: a)
apply simp
apply(case_tac "aa = fst(a)")
by (force simp add: fresh_list_cons fresh_prod)+


lemma seqSubstZero[simp]:
  fixes σ :: "(name × name) list"

  shows "𝟬[<σ>] = 𝟬"
by(induct σ, auto)

lemma seqSubstTau[simp]:
  fixes P :: pi
  and   σ :: "(name × name) list"

  shows "(τ.(P))[<σ>] = τ.(P[<σ>])"
by(induct σ arbitrary: P, auto)

lemma seqSubstOutput[simp]:
  fixes a :: name
  and   b :: name
  and   P :: pi
  and   σ :: "(name × name) list"
  
  shows "(a{b}.P)[<σ>] = (seq_subst_name a σ){(seq_subst_name b σ)}.(P[<σ>])"
by(induct σ arbitrary: a b P, auto)

lemma seqSubstInput[simp]:
  fixes a :: name
  and   x :: name
  and   P :: pi
  and   σ :: "(name × name) list"

  assumes "x  σ"
 
  shows "(a<x>.P)[<σ>] = (seq_subst_name a σ)<x>.(P[<σ>])"
using assms
by(induct σ arbitrary: a x P) (auto simp add: fresh_list_cons fresh_prod)

lemma seqSubstMatch[simp]:
  fixes a :: name
  and   b :: name
  and   P :: pi
  and   σ :: "(name × name) list"

  shows "([ab]P)[<σ>] = [(seq_subst_name a σ)(seq_subst_name b σ)](P[<σ>])"
by(induct σ arbitrary: a b P, auto)

lemma seqSubstMismatch[simp]:
  fixes a :: name
  and   b :: name
  and   P :: pi
  and   σ :: "(name × name) list"

  shows "([ab]P)[<σ>] = [(seq_subst_name a σ)(seq_subst_name b σ)](P[<σ>])"
by(induct σ arbitrary: a b P, auto)

lemma seqSubstSum[simp]:
  fixes P :: pi
  and   Q :: pi
  and   σ :: "(name × name) list"

  shows "(P  Q)[<σ>] = (P[<σ>])  (Q[<σ>])"
by(induct σ arbitrary: P Q , auto)

lemma seqSubstPar[simp]:
  fixes P :: pi
  and   Q :: pi
  and   σ :: "(name × name) list"

  shows "(P  Q)[<σ>] = (P[<σ>])  (Q[<σ>])"
by(induct σ arbitrary: P Q, auto)

lemma seqSubstRes[simp]:
  fixes x :: name
  and   P :: pi
  and   σ :: "(name × name) list"

  assumes "x  σ"

  shows "(x>P)[<σ>] = x>(P[<σ>])"
using assms
by(induct σ arbitrary: x P) (auto simp add: fresh_list_cons fresh_prod)

lemma seqSubstBang[simp]:
  fixes P :: pi
  and   s :: "(name × name) list"

  shows "(!P)[<σ>] = !(P[<σ>])"
by(induct σ arbitrary: P, auto)

lemma seqSubstEqvt[eqvt, simp]:
  fixes P :: pi
  and   σ :: "(name × name) list"
  and   p :: "name prm"

  shows "p  (P[<σ>]) = (p  P)[<(p  σ)>]"
by(induct σ arbitrary: P, auto simp add: eqvt_subs)

lemma seqSubstAppend[simp]:
  fixes P  :: pi
  and   σ  :: "(name × name) list"
  and   σ' :: "(name × name) list"

  shows "P[<(σ@σ')>] = (P[<σ>])[<σ'>]"
by(induct σ arbitrary: P, auto)

lemma freshSubstChain[intro]:
  fixes P :: pi
  and   σ :: "(name × name) list"
  and   a :: name

  assumes "a  P"
  and     "a  σ"

  shows "a  P[<σ>]"
using assms
by(induct σ arbitrary: a P, auto simp add: fresh_list_cons fresh_prod fresh_fact1)

end

Theory Late_Semantics

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Late_Semantics
  imports Agent
begin
 
nominal_datatype subject = InputS name
                         | BoundOutputS name

nominal_datatype freeRes = OutputR name name             ("_[_]" [130, 130] 110)
                         | TauR                          ("τ" 130)

nominal_datatype residual = BoundR subject "«name» pi" ("_«_»  _" [80, 80, 80] 80)
                          | FreeR freeRes pi           ("_  _" [80, 80] 80)

lemmas residualInject = residual.inject freeRes.inject subject.inject

abbreviation "Transitions_Inputjudge" :: "name  name  pi  residual" ("_<_>  _" [80, 80, 80] 80)
where "a<x>  P'  ((InputS a)«x»  P')"

abbreviation "Transitions_BoundOutputjudge" :: "name  name  pi  residual" ("__>  _" [80, 80, 80] 80)
where "ax>  P'  (BoundR (BoundOutputS a) x P')"

inductive transitions :: "pi  residual  bool"      ("_  _" [80, 80] 80)
where
  Tau:               "τ.(P)  τ  P"
| Input:             "x  a  a<x>.P  a<x>  P"
| Output:            "a{b}.P  a[b]   P"
 
| Match:             "P  Rs  [bb]P  Rs"
| Mismatch:          "P  Rs; a  b  [ab]P  Rs"

| Open:              "P  a[b]  P'; a  b  b>P  ab>  P'"
| Sum1:              "P  Rs  (P  Q)  Rs"
| Sum2:              "Q  Rs  (P  Q)  Rs"

| Par1B:             "P  a«x»  P'; x  P; x  Q; x  a  P  Q  a«x»  (P'  Q)"
| Par1F:             "P  α  P'  P  Q  α  (P'  Q)"
| Par2B:             "Q  a«x»  Q'; x  P; x  Q; x  a  P  Q  a«x»  (P  Q')"
| Par2F:             "Q  α  Q'  P  Q  α  (P  Q')"

| Comm1:             "P  a<x>  P'; Q  a[b]  Q'; x  P; x  Q; x  a; x  b; x  Q'  P  Q  τ  P'[x::=b]  Q'"
| Comm2:             "P  a[b]  P'; Q  a<x>  Q'; x  P; x  Q; x  a; x  b; x  P'  P  Q  τ  P'  Q'[x::=b]"
| Close1:            "P  a<x>  P'; Q  ay>  Q'; x  P; x  Q; y  P; 
                       y  Q; x  a; x  Q'; y  a; y  P'; x  y  P  Q  τ  y>(P'[x::=y]  Q')"
| Close2:            "P  ay>  P'; Q  a<x>  Q'; x  P; x  Q; y  P;
                       y  Q; x  a; x  P'; y  a; y  Q'; x  y  P  Q  τ  y>(P'  Q'[x::=y])"

| ResB:              "P  a«x»  P'; y  a; y  x; x  P; x  a  y>P  a«x»  y>P'"
| ResF:              "P  α  P'; y  α  y>P  α  y>P'"

| Bang:              "P  !P  Rs  !P  Rs"

equivariance transitions
nominal_inductive transitions
by(auto simp add: abs_fresh fresh_fact2)

lemma alphaBoundResidual:
  fixes a  :: subject
  and   x  :: name
  and   P  :: pi
  and   x' :: name

  assumes A1: "x'  P"

  shows "a«x»  P = a«x'»  ([(x, x')]  P)"
proof(cases "x=x'")
  assume "x=x'"
  thus ?thesis by simp
next
  assume "x  x'"
  with A1 show ?thesis
    by(simp add: residualInject alpha name_fresh_left name_calc)
qed

lemma freshResidual:
  fixes P  :: pi
  and   Rs :: residual
  and   x  :: name
  
  assumes "P  Rs"
  and     "x  P"

  shows "x  Rs"
using assms
by(nominal_induct rule: transitions.strong_induct)
  (auto simp add: abs_fresh fresh_fact2 fresh_fact1)

lemma freshBoundDerivative:
  assumes "P a«x»  P'"
  and     "y  P"

  shows "y  a"
  and   "y  x  y  P'"
apply -
using assms
by(fastforce dest: freshResidual simp add: abs_fresh)+

lemma freshFreeDerivative:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   y  :: name

  assumes "P α  P'"
  and     "y  P"

  shows "y  α"
  and   "y  P'"
apply -
using assms
by(fastforce dest: freshResidual)+

lemma substTrans[simp]: 
  fixes b :: name
  and   P :: pi
  and   a :: name
  and   c :: name

  assumes "b  P"

  shows "(P[a::=b])[b::=c] = P[a::=c]"
using assms
apply(simp add: injPermSubst[THEN sym])
apply(simp add: renaming)
by(simp add: pt_swap[OF pt_name_inst, OF at_name_inst])

lemma Input:
  fixes a :: name
  and   x :: name
  and   P :: pi

  shows "a<x>.P a<x>  P"
proof -
  obtain y::name where "y  a" and "y  P"
    by(generate_fresh "name", auto simp add: fresh_prod)
  from y  P have "a<x>.P = a<y>.([(x, y)]  P)" and "a<x>  P = a<y>  ([(x, y)]  P)"
    by(auto simp add: alphaBoundResidual alphaInput)
  with y  a show ?thesis by(force intro: Input)
qed

declare perm_fresh_fresh[simp] name_swap[simp] fresh_prod[simp]

lemma Par1B:
  fixes P  :: pi
  and   a  :: subject
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi

  assumes "P a«x»  P'"
  and     "x  Q"

  shows "P  Q a«x»  P'  Q"
proof -
  obtain y::name where "y  P" and "y  P'" and "y  Q" and "y  a"
    by(generate_fresh "name", auto)
  from P  a«x»  P' y  P' have "P a«y»  ([(x, y)]  P')"
    by(simp add: alphaBoundResidual)
  hence "P  Q a«y»  ([(x, y)]  P')  Q" using y  P y  Q y  a
    by(rule Par1B)
  with x  Q y  P' y  Q show ?thesis
    by(subst alphaBoundResidual[where x'=y]) auto
qed

lemma Par2B:
  fixes Q  :: pi
  and   a  :: subject
  and   x  :: name
  and   Q' :: pi
  and   P  :: pi

  assumes QTrans: "Q a«x»  Q'"
  and     "x  P"

  shows "P  Q a«x»  P  Q'"
proof -
  obtain y::name where "y  Q" and "y  Q'" and "y  P" and "y  a"
    by(generate_fresh "name", auto simp add: fresh_prod)
  from QTrans y  Q' have "Q a«y»  ([(x, y)]  Q')"
    by(simp add:alphaBoundResidual)
  hence "P  Q a«y»  P  ([(x, y)]  Q')" using y  P y  Q y  a
    by(rule Par2B)
  moreover have "a«y»  P  ([(x, y)]  Q') = a«x»  P  Q'"
  proof -
    from y  Q' x  P have "x  P  ([(x, y)]  Q')" by(auto simp add: calc_atm fresh_left)
    with x  P y  P show ?thesis by(simp only: alphaBoundResidual, auto simp add: name_swap name_fresh_fresh)
  qed
  ultimately show ?thesis by simp
qed

lemma Comm1:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   b  :: name
  and   Q' :: pi

  assumes PTrans: "P a<x>  P'"
  and     QTrans: "Q a[b]  Q'"

  shows "P  Q τ  P'[x::=b]  Q'"
proof -
  obtain y::name where "y  P" and "y  P'" and "y  Q" and "y  a" and "y  b" and "y  Q'"
    by(generate_fresh "name", auto simp add: fresh_prod)
  from PTrans y  P' have "P a<y>  ([(x, y)]  P')"
    by(simp add: alphaBoundResidual)
  hence "P  Q τ  ([(x, y)]  P')[y::=b]  Q'" 
    using QTrans y  P y  Q y  a y  b y  Q' 
    by(rule Comm1)
  with y  P' show ?thesis by(simp add: renaming name_swap)
qed

lemma Comm2:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   Q  :: pi
  and   x  :: name
  and   Q' :: pi

  assumes PTrans: "P a[b]  P'"
  and     QTrans: "Q a<x>  Q'"

  shows "P  Q τ  P'  (Q'[x::=b])"
proof -
  obtain y::name where "y  P" and "y  P'" and "y  Q" and "y  a" and "y  b" and "y  Q'"
    by(generate_fresh "name", auto simp add: fresh_prod)
  from QTrans y  Q' have "Q a<y>  ([(x, y)]  Q')"
    by(simp add: alphaBoundResidual)
  with PTrans have "P  Q τ  P'  (([(x, y)]  Q')[y::=b])"
  using y  P y  Q y  a y  b y  P'
    by(rule Comm2)
  with y  Q' show ?thesis by(simp add: renaming name_swap)
qed

lemma Close1:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   y  :: name
  and   Q' :: pi

  assumes PTrans: "P a<x>  P'"
  and     QTrans: "Q ay>  Q'"
  and     "y  P"

  shows "P  Q τ  y>(P'[x::=y]  Q')"
proof - 
  obtain x'::name where "x'  P" and "x'  P'" and "x'  Q" and "x'  Q'" and "x'  a"
    by(generate_fresh "name", auto simp add: fresh_prod)
  obtain y'::name where "y'  P" and "y'  Q'" and "y'  Q"
                    and "y'  P'" and "y'  x'" and "y'  y" and "y'  a"
    by(generate_fresh "name", auto simp add: fresh_prod)
  from PTrans x'  P' have "P a<x'>  ([(x, x')]  P')"
    by(simp add: alphaBoundResidual)
  moreover from QTrans y'  Q' have "Q ay'>  ([(y, y')]  Q')"
    by(simp add: alphaBoundResidual)
  ultimately have "P  Q τ  y'>(([(x, x')]  P')[x'::=y']  ([(y, y')]  Q'))"
    using y'  P y'  Q x'  P x'  Q y'  x' y'  a x'  a
          y'  P' y'  Q' x'  P' x'  Q'
    apply(rule_tac Close1)
    by assumption (auto simp add: fresh_left calc_atm)
  moreover have "y'>(([(x, x')]  P')[x'::=y']  ([(y, y')]  Q')) = y>(P'[x::=y]  Q')"
  proof -
    from x'  P' have "([(x, x')]  P')[x'::=y'] = P'[x::=y']" by(simp add: renaming name_swap)
    moreover have "y  (P'[x::=y']  ([(y, y')]  Q'))"
    proof(case_tac "y = x")
      assume "y = x"
      with y'  Q' y'  y show ?thesis by(auto simp add: fresh_fact2 fresh_left calc_atm)
    next
      assume "y  x"
      with y  P PTrans have "y  P'" by(force dest: freshBoundDerivative)
      with y'  Q' y'  y show ?thesis by(auto simp add: fresh_left calc_atm fresh_fact1)
    qed
    ultimately show ?thesis using y'  P' apply(simp only: alphaRes)
      by(auto simp add: name_swap eqvt_subs calc_atm renaming)
  qed
  ultimately show ?thesis by simp
qed

lemma Close2:
  fixes P  :: pi
  and   a  :: name
  and   y  :: name
  and   P' :: pi
  and   Q  :: pi
  and   x  :: name
  and   Q' :: pi

  assumes PTrans: "P ay>  P'"
  and     QTrans: "Q a<x>  Q'"
  and     "y  Q"

  shows "P  Q τ  y>(P'  (Q'[x::=y]))"
proof -
  obtain x'::name where "x'  P" and "x'  Q'" and "x'  Q" and "x'  P'" and "x'  a"
    by(generate_fresh "name", auto simp add: fresh_prod)
  obtain y'::name where "y'  P" and "y'  P'" and "y'  Q"
                    and "y'  Q'" and "y'  x'" and "y'  y" and "y'  a"
    by(generate_fresh "name", auto simp add: fresh_prod)
  from PTrans y'  P' have "P ay'>  ([(y, y')]  P')"
    by(simp add: alphaBoundResidual)
  moreover from QTrans x'  Q' have "Q a<x'>  ([(x, x')]  Q')"
    by(simp add: alphaBoundResidual)
  ultimately have "P  Q τ  y'>(([(y, y')]  P')  (([(x, x')]  Q')[x'::=y']))"
    using y'  P y'  Q x'  P x'  Q y'  x' x'  a y'  a
          x'  P' x'  Q' y'  P' y'  Q'
    by(rule_tac Close2) (assumption | auto simp add: fresh_left calc_atm)+
  moreover have "y'>(([(y, y')]  P')  (([(x, x')]  Q')[x'::=y'])) = y>(P'  (Q'[x::=y]))"
  proof -
    from x'  Q' have "([(x, x')]  Q')[x'::=y'] = Q'[x::=y']" by(simp add: renaming name_swap)
    moreover have "y  (([(y, y')]  P')  (Q'[x::=y']))"
    proof(case_tac "y = x")
      assume "y = x"
      with y'  P' y'  y show ?thesis by(auto simp add: fresh_fact2 fresh_left calc_atm)
    next
      assume "y  x"
      with y  Q QTrans have "y  Q'" by(force dest: freshBoundDerivative)
      with y'  P' y'  y show ?thesis by(auto simp add: fresh_left calc_atm fresh_fact1)
    qed
    ultimately show ?thesis using y'  Q' apply(simp only: alphaRes)
      by(auto simp add: name_swap eqvt_subs calc_atm renaming)
  qed
  ultimately show ?thesis by simp
qed

lemma ResB: 
  fixes P  :: pi
  and   a  :: subject
  and   x  :: name
  and   P' :: pi
  and   y  :: name

  assumes PTrans: "P a«x»  P'"
  and     "y  a"
  and     "y  x"

  shows "y>P a«x»  y>P'"
proof -
  obtain z where "z  P" and "z  a" and "z  y" and "z  P'"
    by(generate_fresh "name", auto simp add: fresh_prod)
  from PTrans z  P'  have "P a«z»  ([(x, z)]  P')" by(simp add: alphaBoundResidual)
  with z  P z  a z  y y  a have "y>P a«z»  y>([(x, z)]  P')" by(rule_tac ResB) auto
  moreover have "a«z»  y>([(x, z)]  P') = a«x»  y>P'"
  proof -
    from z  P' y  x have "x  y>([(x, z)]  P')" by(auto simp add: abs_fresh fresh_left calc_atm)
    with y  x z  y show ?thesis by(simp add: alphaBoundResidual name_swap calc_atm)
  qed
  ultimately show ?thesis by simp
qed

lemma outputInduct[consumes 1, case_names Output Match Mismatch Sum1 Sum2 Par1 Par2 Res Bang]:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   F  :: "'a::fs_name  pi  name  name  pi  bool"
  and   C  :: "'a::fs_name"

  assumes Trans:  "P a[b]  P'"
  and     "a b P C. F C (a{b}.P) a b P"
  and     "P a b P' c C. P OutputR a b  P'; C. F C P a b P'  F C ([cc]P) a b P'"
  and     "P a b P' c d C. P OutputR a b  P'; C. F C P a b P'; c  d  F C ([cd]P) a b P'"
  and     "P a b P' Q C. P OutputR a b  P'; C. F C P a b P'  F C (P  Q) a b P'"
  and     "Q a b Q' P C. Q OutputR a b  Q'; C. F C Q a b Q'  F C (P  Q) a b Q'"
  and     "P a b P' Q C. P OutputR a b  P'; C. F C P a b P'  F C (P  Q) a b (P'  Q)"
  and     "Q a b Q' P C. Q OutputR a b  Q'; C. F C Q a b Q'  F C (P  Q) a b (P  Q')"
  and     "P a b P' x C. P OutputR a b  P'; x  a; x  b; x  C; C. F C P a b P' 
                            F C (x>P) a b (x>P')"
  and     "P a b P' C. P  !P OutputR a b  P'; C. F C (P  !P) a b P'  F C (!P) a b P'"

  shows "F C P a b P'"
proof -
  from Trans show ?thesis
  by(nominal_induct x2 == "OutputR a b  P'" avoiding: C arbitrary: P' rule: transitions.strong_induct,
     auto simp add: residualInject freeRes.inject intro: assms)
qed

lemma inputInduct[consumes 2, case_names Input Match Mismatch Sum1 Sum2 Par1 Par2 Res Bang]:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   F  :: "('a::fs_name)  pi  name  name  pi  bool"
  and   C  :: "'a::fs_name"

  assumes a: "P a<x>  P'"
  and       "x  P"
  and     cInput:    "a x P C. F C (a<x>.P) a x P"
  and     cMatch:    "P a x P' b C. P a<x>  P'; C. F C P a x P'  F C ([bb]P) a x P'"
  and     cMismatch: "P a x P' b  c C. P a<x>  P'; C. F C P a x P'; b  c  F C ([bc]P) a x P'"
  and     cSum1:     "P Q a x P' C. P a<x>  P'; C. F C P a x P'  F C (P  Q) a x P'" 
  and     cSum2:     "P Q a x Q' C. Q a<x>  Q'; C. F C Q a x Q'  F C (P  Q) a x Q'" 
  and     cPar1B:    "P P' Q a x C. P a<x>  P'; x  P; x  Q; x  a; C. F C P a x P' 
                                       F C (P  Q) a x (P'  Q)" 
  and     cPar2B:    "P Q Q' a x C. Q a<x>  Q'; x  P; x  Q; x  a; C. F C Q a x Q' 
                                       F C (P  Q) a x (P  Q')"
  and     cResB:     "P P' a x y C. P a<x>  P'; y  a; y  x; y  C;
                                      C. F C P a x P'  F C (y>P) a x (y>P')"
  and     cBang:     "P a x P' C. P  !P a<x>  P'; C. F C (P  !P) a x P' 
                                     F C (!P) a x P'"
  shows "F C P a x P'"
proof -
  from a x  P show ?thesis
  proof(nominal_induct x2 == "a<x>  P'" avoiding: C a x P' rule: transitions.strong_induct)
    case(Tau P)
    thus ?case by(simp add: residualInject)
  next
    case(Input x a P C a' x' P')
    have "x  x'" by fact hence "x  x'" by simp
    moreover have "a<x>  P = a'<x'>  P'" by fact
    ultimately have aeqa': "a = a'" and PeqP': "P = [(x, x')]  P'"
      by(simp add: residualInject freeRes.inject subject.inject name_abs_eq)+
    
    have "F C (a<x'>.([(x, x')]  P)) a x' ([(x, x')]  P)" by(rule cInput)
    moreover have "x  P'" by fact
    ultimately show ?case using PeqP' aeqa' by(simp add: alphaInput name_swap)
  next
    case(Output P a b)
    thus ?case by(simp add: residualInject)
  next
    case(Match P b Rs a x)
    thus ?case 
      by(force intro: cMatch simp add: residualInject) 
  next
    case(Mismatch P Rs a b C a x)
    thus ?case 
      by(force intro: cMismatch simp add: residualInject) 
  next
    case(Open P P' a b C a' x P')
    thus ?case by(simp add: residualInject)
  next
    case(Sum1 P Q Rs C)
    thus ?case by(force intro: cSum1)
  next
    case(Sum2 P Q Rs C)
    thus ?case by(force intro: cSum2)
  next
    case(Par1B P a x P' Q C a' x' P'')
    have "x  x'" by fact hence xineqx': "x  x'" by simp
    moreover have Eq: "a«x»  (P'  Q) = a'<x'>  P''" by fact
    hence aeqa': "a = InputS a'" by(simp add: residualInject)
    have "x'  P  Q" by fact
    hence "x'  P" and "x'  Q" by simp+
    have P''eq: "P'' = ([(x, x')]  P')  Q"
    proof -
      from Eq xineqx' have "(P'  Q) = [(x, x')]  P''"
        by(simp add: residualInject name_abs_eq)
      hence "([(x, x')]  (P'  Q)) = P''" by simp
      with x'  Qx  Q show ?thesis by(simp add: name_fresh_fresh)
    qed
    
    have "x  P''" by fact
    with P''eq x  x' have "x'  P'" by(simp add: name_fresh_left name_calc)
    
    have PTrans: "P a«x»  P'" by fact
    with x'  P' aeqa' have "P a'<x'>  ([(x, x')]  P')"
      by(simp add: alphaBoundResidual)
    moreover have "C. F C P a' x' ([(x, x')]  P')"
    proof -
      fix C
      have "C a' x' P''. a«x»  P' = a'<x'>  P''; x'  P  F C P a' x' P''" by fact
      moreover with aeqa' xineqx' x'  P' have "a«x»  P' = a'<x'>  ([(x, x')]  P')"
        by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
      ultimately show "F C P a' x' ([(x, x')]  P')" using x'  P by blast 
    qed
    moreover from PTrans x'  P have "x'  a" by(auto dest: freshBoundDerivative)
    ultimately have "F C (P  Q) a' x' (([(x, x')]  P')  Q)" using x'  Qaeqa' x'  P
      by(rule_tac cPar1B) auto
    with P''eq show ?case by simp
  next
    case(Par1F P P' Q α)
    thus ?case by(simp add: residualInject)
  next
    case(Par2B Q a x Q' P C a' x' Q'')
    have "x  x'" by fact hence xineqx': "x  x'" by simp
    moreover have Eq: "a«x»  (P  Q') = a'<x'>  Q''" by fact
    hence aeqa': "a = InputS a'" by(simp add: residualInject)
    have "x  P" by fact
    have "x'  P  Q" by fact
    hence "x'  P" and "x'  Q" by simp+
    have Q''eq: "Q'' = P  ([(x, x')]  Q')"
    proof -
      from Eq xineqx' have "(P  Q') = [(x, x')]  Q''"
        by(simp add: residualInject name_abs_eq)
      hence "([(x, x')]  (P  Q')) = Q''" by simp
      with x'  P x  P show ?thesis by(simp add: name_fresh_fresh)
    qed
    
    have "x  Q''" by fact
    with Q''eq x  x' have "x'  Q'" by(simp add: name_fresh_left name_calc)
    
    have QTrans: "Q a«x»  Q'" by fact
    with x'  Q' aeqa' have "Q a'<x'>  ([(x, x')]  Q')"
      by(simp add: alphaBoundResidual)
    moreover have "C. F C Q a' x' ([(x, x')]  Q')"
    proof -
      fix C
      have "C a' x' Q''. a«x»  Q' = a'<x'>  Q''; x'  Q  F C Q a' x' Q''" by fact
      moreover with aeqa' xineqx' x'  Q' have "a«x»  Q' = a'<x'>  ([(x, x')]  Q')"
        by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
      ultimately show "F C Q a' x' ([(x, x')]  Q')" using x'  Qaeqa' by blast 
    qed
    moreover from QTrans x'  Q have "x'  a" by(force dest: freshBoundDerivative)
    ultimately have "F C (P  Q) a' x' (P  ([(x, x')]  Q'))" using x'  P aeqa' x'  Q
      by(rule_tac cPar2B) auto
    with Q''eq show ?case by simp
  next
    case(Par2F P P' Q α)
    thus ?case by(simp add: residualInject)
  next
    case(Comm1 P P' Q Q' a b x)
    thus ?case by(simp add: residualInject)
  next
    case(Comm2 P P' Q Q' a b x)
    thus ?case by(simp add: residualInject)
  next
    case(Close1 P P' Q Q' a x y)
    thus ?case by(simp add: residualInject)
  next
    case(Close2 P P' Q Q' a x y)
    thus ?case by(simp add: residualInject)
  next
    case(ResB P a x P' y C a' x' P'')
    have "x  x'" by fact hence xineqx': "x  x'" by simp
    moreover have Eq: "a«x»  (y>P') = a'<x'>  P''" by fact
    hence aeqa': "a = InputS a'" by(simp add: residualInject)
    have "y  x'" by fact hence yineqx': "y  x'" by simp
    moreover have "x'  y>P" by fact
    ultimately have "x'  P" by(simp add: name_fresh_abs)
    have "y  x" and yineqa: "y  a" and yFreshC: "y  C" by fact+
    
    have P''eq: "P'' = y>([(x, x')]  P')"
    proof -
      from Eq xineqx' have "y>P' = [(x, x')]  P''"
        by(simp add: residualInject name_abs_eq)
      hence "([(x, x')]  (y>P')) = P''" by simp
      with yineqx' y  x show ?thesis by(simp add: name_fresh_fresh)
    qed
    
    have "x  P''" by fact
    with P''eq y  x x  x' have "x'  P'" by(simp add: name_fresh_left name_calc name_fresh_abs)
    
    have "P a«x»  P'" by fact
    with x'  P' aeqa' have "P a'<x'>  ([(x, x')]  P')"
      by(simp add: alphaBoundResidual)
    moreover have "C. F C P a' x' ([(x, x')]  P')"
    proof -
      fix C
      have "C a' x' P''. a«x»  P' = a'<x'>  P''; x'  P  F C P a' x' P''" by fact
      moreover with aeqa' xineqx' x'  P' have "a«x»  P' = a'<x'>  ([(x, x')]  P')"
        by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
      ultimately show "F C P a' x' ([(x, x')]  P')" using x'  P aeqa' by blast 
    qed
    ultimately have "F C (y>P) a' x' (y>([(x, x')]  P'))" using yineqx' yineqa yFreshC aeqa'
      by(force intro: cResB)
    with P''eq show ?case by simp
  next
    case(ResF P P' α y)
    thus ?case by(simp add: residualInject)
  next
    case(Bang P Rs)
    thus ?case by(force intro: cBang)
  qed
qed

lemma boundOutputInduct[consumes 2, case_names Match Mismatch Open Sum1 Sum2 Par1 Par2 Res Bang]:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   F  :: "('a::fs_name)  pi  name  name  pi  bool"
  and   C  :: "'a::fs_name"

  assumes a: "P ax>  P'"
  and       "x  P"
  and     cMatch:    "P a x P' b C. P ax>  P'; C. F C P a x P'  F C ([bb]P) a x P'"
  and     cMismatch: "P a x P' b c C. P ax>  P'; C. F C P a x P'; b  c  F C ([bc]P) a x P'"
  and     cOpen:     "P a x P' C.   P (OutputR a x)  P'; a  x  F C (x>P) a x P'"
  and     cSum1:     "P Q a x P' C. P ax>  P'; C. F C P a x P'  F C (P  Q) a x P'" 
  and     cSum2:     "P Q a x Q' C. Q ax>  Q'; C. F C Q a x Q'  F C (P  Q) a x Q'" 
  and     cPar1B:    "P P' Q a x C. P ax>  P'; x  Q; C. F C P a x P' 
                                       F C (P  Q) a x (P'  Q)" 
  and     cPar2B:    "P Q Q' a x C. Q ax>  Q'; x  P; C. F C Q a x Q' 
                                       F C (P  Q) a x (P  Q')"
  and     cResB:     "P P' a x y C. P ax>  P'; y  a; y  x; y  C;
                                       C. F C P a x P'  F C (y>P) a x (y>P')"
  and     cBang:     "P a x P' C. P  !P ax>  P'; C. F C (P  !P) a x P' 
                                     F C (!P) a x P'"
  shows "F C P a x P'"
proof -
  from a x  P show ?thesis
  proof(nominal_induct x2 == "ax>  P'" avoiding: C a x P' rule: transitions.strong_induct)
    case(Tau P)
    thus ?case by(simp add: residualInject)
  next
    case(Input P a x)
    thus ?case by(simp add: residualInject)
  next
    case(Output P a b)
    thus ?case by(simp add: residualInject)
  next
    case(Match P Rs b C a x)
    thus ?case 
      by(force intro: cMatch simp add: residualInject) 
  next
    case(Mismatch P Rs a b C c x)
    thus ?case 
      by(force intro: cMismatch simp add: residualInject) 
  next
    case(Sum1 P Q Rs C)
    thus ?case by(force intro: cSum1)
  next
    case(Sum2 P Q Rs C)
    thus ?case by(force intro: cSum2)
  next
    case(Open P a b P' C a' x P'')
    have "b  x" by fact hence bineqx: "b  x" by simp
    moreover have "ab>  P' = a'x>  P''" by fact
    ultimately have aeqa': "a=a'" and P'eqP'': "P'' = [(b, x)]  P'"
      by(simp add: residualInject name_abs_eq)+
    have "x  b>P" by fact 
    with bineqx have "x  P" by(simp add: name_fresh_abs)
    have aineqb: "a  b" by fact
    
    have PTrans: "P a[b]  P'" by fact
    with x  P have xineqa: "x  a" by(force dest: freshFreeDerivative)
    from PTrans have "([(b, x)]  P) [(b, x)]  (a[b]  P')" by(rule transitions.eqvt)
    with P'eqP'' xineqa aineqb have Trans: "([(b, x)]  P) a[x]  P''"
      by(auto simp add: name_calc)
    hence "F C (x>([(b, x)]  P)) a x P''" using xineqa by(blast intro: cOpen)
    with x  P aeqa' show ?case by(simp add: alphaRes)
  next
    case(Par1B P a x P' Q C a' x' P'')
    have "x  x'" by fact hence xineqx': "x  x'" by simp
    moreover have Eq: "a«x»  (P'  Q) = a'x'>  P''" by fact
    hence aeqa': "a = BoundOutputS a'" by(simp add: residualInject)
    have "x  Q" by fact
    have "x'  P  Q" by fact
    hence "x'  P" and "x'  Q" by simp+
    have P''eq: "P'' = ([(x, x')]  P')  Q"
    proof -
      from Eq xineqx' have "(P'  Q) = [(x, x')]  P''"
        by(simp add: residualInject name_abs_eq)
      hence "([(x, x')]  (P'  Q)) = P''" by simp
      with x'  Qx  Q show ?thesis by(simp add: name_fresh_fresh)
    qed
    
    have "x  P''" by fact
    with P''eq x  x' have "x'  P'" by(simp add: name_fresh_left name_calc)

    have "P a«x»  P'" by fact
    with x'  P' aeqa' have "P a'x'>  ([(x, x')]  P')"
      by(simp add: alphaBoundResidual)
    moreover have "C. F C P a' x' ([(x, x')]  P')"
    proof -
      fix C
      have "C a' x' P''. a«x»  P' = a'x'>  P''; x'  P  F C P a' x' P''" by fact
      moreover with aeqa' xineqx' x'  P' have "a«x»  P' = a'x'>  ([(x, x')]  P')"
        by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
      ultimately show "F C P a' x' ([(x, x')]  P')" using x'  P aeqa' by blast 
    qed
    ultimately have "F C (P  Q) a' x' (([(x, x')]  P')  Q)" using x'  Qaeqa'
      by(blast intro: cPar1B)
    with P''eq show ?case by simp
  next
    case(Par1F P P' Q α)
    thus ?case by(simp add: residualInject)
  next
    case(Par2B Q a x Q' P C a' x' Q'')
    have "x  x'" by fact hence xineqx': "x  x'" by simp
    moreover have Eq: "a«x»  (P  Q') = a'x'>  Q''" by fact
    hence aeqa': "a = BoundOutputS a'" by(simp add: residualInject)
    have "x  P" by fact
    have "x'  P  Q" by fact
    hence "x'  P" and "x'  Q" by simp+
    have Q''eq: "Q'' = P  ([(x, x')]  Q')"
    proof -
      from Eq xineqx' have "(P  Q') = [(x, x')]  Q''"
        by(simp add: residualInject name_abs_eq)
      hence "([(x, x')]  (P  Q')) = Q''" by simp
      with x'  P x  P show ?thesis by(simp add: name_fresh_fresh)
    qed
    
    have "x  Q''" by fact
    with Q''eq x  x' have "x'  Q'" by(simp add: name_fresh_left name_calc)

    have "Q a«x»  Q'" by fact
    with x'  Q' aeqa' have "Q a'x'>  ([(x, x')]  Q')"
      by(simp add: alphaBoundResidual)
    moreover have "C. F C Q a' x' ([(x, x')]  Q')"
    proof -
      fix C
      have "C a' x' Q''. a«x»  Q' = a'x'>  Q''; x'  Q  F C Q a' x' Q''" by fact
      moreover with aeqa' xineqx' x'  Q' have "a«x»  Q' = a'x'>  ([(x, x')]  Q')"
        by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
      ultimately show "F C Q a' x' ([(x, x')]  Q')" using x'  Qaeqa' by blast 
    qed
    ultimately have "F C (P  Q) a' x' (P  ([(x, x')]  Q'))" using x'  P
      by(blast intro: cPar2B)
    with Q''eq show ?case by simp
  next
    case(Par2F P P' Q α)
    thus ?case by(simp add: residualInject)
  next
    case(Comm1 P P' Q Q' a b x)
    thus ?case by(simp add: residualInject)
  next
    case(Comm2 P P' Q Q' a b x)
    thus ?case by(simp add: residualInject)
  next
    case(Close1 P P' Q Q' a x y)
    thus ?case by(simp add: residualInject)
  next
    case(Close2 P P' Q Q' a x y)
    thus ?case by(simp add: residualInject)
  next
    case(ResB P a x P' y C a' x' P'')
    have "x  x'" by fact hence xineqx': "x  x'" by simp
    moreover have Eq: "a«x»  (y>P') = a'x'>  P''" by fact
    hence aeqa': "a = BoundOutputS a'" by(simp add: residualInject)
    have "y  x'" by fact hence yineqx': "y  x'" by simp
    moreover have "x'  y>P" by fact
    ultimately have "x'  P" by(simp add: name_fresh_abs)
    have "y  x" and "y  a" and yFreshC: "y  C" by fact+

    have P''eq: "P'' = y>([(x, x')]  P')"
    proof -
      from Eq xineqx' have "y>P' = [(x, x')]  P''"
        by(simp add: residualInject name_abs_eq)
      hence "([(x, x')]  (y>P')) = P''" by simp
      with yineqx' y  x show ?thesis by(simp add: name_fresh_fresh)
    qed

    have "x  P''" by fact
    with P''eq y  x x  x' have "x'  P'" by(simp add: name_fresh_left name_calc name_fresh_abs)

    have "P a«x»  P'" by fact
    with x'  P' aeqa' have "P a'x'>  ([(x, x')]  P')"
      by(simp add: alphaBoundResidual)
    moreover have "C. F C P a' x' ([(x, x')]  P')"
    proof -
      fix C
      have "C a' x' P''. a«x»  P' = a'x'>  P''; x'  P  F C P a' x' P''" by fact
      moreover with aeqa' xineqx' x'  P' have "a«x»  P' = a'x'>  ([(x, x')]  P')"
        by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
      ultimately show "F C P a' x' ([(x, x')]  P')" using x'  P aeqa' by blast 
    qed
    ultimately have "F C (y>P) a' x' (y>([(x, x')]  P'))" using yineqx' y  a yFreshC aeqa'
      by(force intro: cResB)
    with P''eq show ?case by simp
  next
    case(ResF P P' α y)
    thus ?case by(simp add: residualInject)
  next
    case(Bang P Rs)
    thus ?case by(force intro: cBang)
  qed
qed

lemma tauInduct[consumes 1, case_names Tau Match Mismatch Sum1 Sum2 Par1 Par2 Comm1 Comm2 Close1 Close2 Res Bang]:
  fixes P  :: pi
  and   P' :: pi
  and   F  :: "'a::fs_name  pi  pi  bool"
  and   C  :: "'a::fs_name"

  assumes Trans:  "P τ  P'"
  and     "P C. F C (τ.(P)) P"
  and     "P P' c C. P τ  P'; C. F C P P'  F C ([cc]P) P'"
  and     "P P' c d C. P τ  P'; C. F C P P'; c  d  F C ([cd]P) P'"
  and     "P P' Q C. P τ  P'; C. F C P P'  F C (P  Q) P'"
  and     "Q Q' P C. Q τ  Q'; C. F C Q Q'  F C (P  Q) Q'"
  and     "P P' Q C. P τ  P'; C. F C P P'  F C (P  Q) (P'  Q)"
  and     "Q Q' P C. Q τ  Q'; C. F C Q Q'  F C (P  Q) (P  Q')"
  and     "P a x P' Q b Q' C. P (BoundR (InputS a) x P'); Q OutputR a b  Q'; x  P; x  Q; x  C  F C (P  Q) (P'[x::=b]  Q')"
  and     "P a b P' Q x Q' C. P OutputR a b  P'; Q (BoundR (InputS a) x Q'); x  P; x  Q; x  C  F C (P  Q) (P'  Q'[x::=b])"
  and     "P a x P' Q y Q' C. P (BoundR (InputS a) x P'); Q ay>  Q'; x  P; x  Q; x  C; y  P; y  Q; y  C; x  y  F C (P  Q) (y>(P'[x::=y]  Q'))"
  and     "P a y P' Q x Q' C. P ay>  P'; Q (BoundR (InputS a) x Q'); x  P; x  Q; x  C; y  P; y  Q; y  C; x  y  F C (P  Q) (y>(P'  Q'[x::=y]))"
  and     "P P' x C. P τ  P'; x  C; C. F C P P' 
                        F C (x>P) (x>P')"
  and     "P P' C. P  !P τ  P'; C. F C (P  !P) P'  F C (!P) P'"

  shows "F C P P'"
proof -
  from Trans show ?thesis
    by(nominal_induct x2=="τ  P'" avoiding: C arbitrary: P' rule: transitions.strong_induct,
       auto simp add: residualInject intro: assms)
qed

inductive bangPred :: "pi  pi  bool"
where
  aux1: "bangPred P (!P)"
| aux2: "bangPred P (P  !P)"

inductive_cases nilCases'[simplified pi.distinct residual.distinct]: "𝟬  Rs"
inductive_cases tauCases'[simplified pi.distinct residual.distinct]: "τ.(P)  Rs"
inductive_cases inputCases'[simplified pi.inject residualInject]: "a<b>.P  Rs"
inductive_cases outputCases'[simplified pi.inject residualInject]: "a{b}.P  Rs"
inductive_cases matchCases'[simplified pi.inject residualInject]: "[ab]P  Rs"
inductive_cases mismatchCases'[simplified pi.inject residualInject]: "[ab]P  Rs"
inductive_cases sumCases'[simplified pi.inject residualInject]: "P  Q  Rs"
inductive_cases parCasesB'[simplified pi.distinct residual.distinct]: "P  Q  b«y»  P'"
inductive_cases parCasesF'[simplified pi.distinct residual.distinct]: "P  Q  α  P'"
inductive_cases resCases'[simplified pi.distinct residual.distinct]: "x>P  Rs"
inductive_cases resCasesB'[simplified pi.distinct residual.distinct]: "x'>P  a«y'»  P'"
inductive_cases resCasesF'[simplified pi.distinct residual.distinct]: "x>P  α  P'"
inductive_cases bangCases[simplified pi.distinct residual.distinct]: "!P  Rs"

lemma tauCases[consumes 1, case_names cTau]:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi

  assumes "τ.(P) α  P'"
  and "α = τ; P = P'  Prop (τ) P"

  shows "Prop α P'"
using assms
by(erule_tac tauCases', auto simp add: pi.inject residualInject)

lemma outputCases[consumes 1, case_names cOutput]:
  fixes a  :: name
  and   b  :: name
  and   P  :: pi
  and   α  :: freeRes
  and   P' :: pi

  assumes "a{b}.P α  P'"
  and "α = a[b]; P = P'  Prop (a[b]) P"

  shows "Prop α P'"
using assms
by(erule_tac outputCases', auto simp add: residualInject)

lemma zeroTrans[dest]:
  fixes Rs :: residual

  assumes "𝟬  Rs"

  shows "False"
using assms
by(induct rule: nilCases', auto)

lemma resZeroTrans[dest]:
  fixes x  :: name
  and   Rs :: residual

  assumes "x>𝟬  Rs"

  shows "False"
using assms
by(induct rule: resCases', auto simp add: pi.inject alpha')

lemma matchTrans[dest]:
  fixes a   :: name
  and   b   :: name
  and   P   :: pi
  and   Rs  :: residual

  assumes "[ab]P  Rs"
  and     "ab"

  shows "False"
using assms
by(induct rule: matchCases', auto)

lemma mismatchTrans[dest]:
  fixes a   :: name
  and   P   :: pi
  and   Rs  :: residual

  assumes "[aa]P  Rs"

  shows "False"
using assms
by(induct rule: mismatchCases', auto)

lemma inputCases[consumes 4, case_names cInput]:
  fixes a  :: name
  and   x  :: name
  and   P  :: pi
  and   P' :: pi

  assumes Input: "a<x>.P  b«y»  yP'"
  and     "y  a"
  and     "y  x"
  and     "y  P"
  and     A:     "b = InputS a; yP' = ([(x, y)]  P)   Prop (InputS a) y ([(x, y)]  P)"

  shows "Prop b y yP'"
proof -
  note assms
  moreover from Input y  a y  x y  P have "y  b"
    by(force dest: freshBoundDerivative simp add: abs_fresh)
  moreover obtain z::name where "z  y" and "z  x" and "z  P" and "z  a" and "z  b" and "z  yP'" 
    by(generate_fresh "name", auto simp add: fresh_prod)
  moreover obtain z'::name where "z'  y" and "z'  x" and "z'  z" and "z'  P" and "z'  a" and "z'  b" and "z'  yP'" 
    by(generate_fresh "name", auto simp add: fresh_prod)
  ultimately show ?thesis
    by(cases rule: transitions.strong_cases[where x=y and b=z and xa=z and xb=z and xc=z and xd=z and xe=z
                                            and xf=z and xg=z and y=z' and ya=z' and yb=y and yc=z'])
      (auto simp add: pi.inject residualInject alpha abs_fresh fresh_prod fresh_left calc_atm)+
qed

lemma tauBoundTrans[dest]:
  fixes P  :: pi
  and   a  :: subject
  and   x  :: name
  and   P' :: pi

  assumes "τ.(P) a«x»  P'"

  shows False
using assms
by - (ind_cases "τ.(P) a«x»  P'") 

lemma tauOutputTrans[dest]:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes "τ.(P) a[b]  P'"

  shows False
using assms
by - (ind_cases "τ.(P) a[b]  P'", auto simp add: residualInject) 

lemma inputFreeTrans[dest]:
  fixes a  :: name
  and   x  :: name
  and   P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  
  assumes "a<x>.P α  P'"

  shows False
using assms
by - (ind_cases "a<x>.P α  P'")

lemma inputBoundOutputTrans[dest]:
  fixes a  :: name
  and   x  :: name
  and   P  :: pi
  and   b  :: name
  and   y  :: name
  and   P' :: pi

  assumes "a<x>.P by>  P'"

  shows False
using assms
by - (ind_cases "a<x>.P by>  P'", auto simp add: residualInject)

lemma outputTauTrans[dest]:
  fixes a  :: name
  and   b  :: name
  and   P  :: pi
  and   P' :: pi

  assumes "a{b}.P τ  P'"

  shows False
using assms
by - (ind_cases "a{b}.P τ  P'", auto simp add: residualInject)

lemma outputBoundTrans[dest]:
  fixes a  :: name
  and   b  :: name
  and   P  :: pi
  and   c  :: subject
  and   x  :: name
  and   P' :: pi

  assumes "a{b}.P c«x»  P'"

  shows False
using assms
by - (ind_cases "a{b}.P c«x»  P'")

lemma outputIneqTrans[dest]:
  fixes a  :: name
  and   b  :: name
  and   P  :: pi
  and   c  :: name
  and   d  :: name
  and   P' :: pi

  assumes "a{b}.P c[d]  P'"
  and     "a  c  b  d"

  shows "False"
using assms
by - (ind_cases "a{b}.P c[d]  P'", auto simp add: residualInject pi.inject alpha')

lemma outputFreshTrans[dest]:
  fixes a  :: name
  and   b  :: name
  and   P  :: pi
  and   α  :: freeRes
  and   P' :: pi

  assumes "a{b}.P α  P'"
  and     "a  α  b  α"

  shows "False"
using assms
by - (ind_cases "a{b}.P α  P'", auto simp add: residualInject pi.inject alpha')

lemma inputIneqTrans[dest]:
  fixes a  :: name
  and   x  :: name
  and   P  :: pi
  and   b  :: subject
  and   y  :: name
  and   P' :: pi

  assumes "a<x>.P b«y»  P'"
  and     "a  b"

  shows "False"
using assms
by - (ind_cases "a<x>.P b«y»  P'", auto simp add: residualInject pi.inject)

lemma resTauBoundTrans[dest]:
  fixes x  :: name
  and   P  :: pi
  and   a  :: subject
  and   y  :: name
  and   P' :: pi

  assumes "x>τ.(P) a«y»  P'"

  shows False
using assms
by - (ind_cases "x>τ.(P) a«y»  P'", auto simp add: residualInject pi.inject alpha')

lemma resTauOutputTrans[dest]:
  fixes x  :: name
  and   P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes "x>τ.(P) a[b]  P'"

  shows False
using assms
by - (ind_cases "x>τ.(P) a[b]  P'", auto simp add: residualInject pi.inject alpha')

lemma resInputFreeTrans[dest]:
  fixes x  :: name
  fixes a  :: name
  and   y  :: name
  and   P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  
  assumes "x>a<y>.P α  P'"

  shows False
using assms
by - (ind_cases "x>a<y>.P α  P'", auto simp add: pi.inject residualInject alpha')

lemma resInputBoundOutputTrans[dest]:
  fixes x  :: name
  and   a  :: name
  and   y  :: name
  and   P  :: pi
  and   b  :: name
  and   z  :: name
  and   P' :: pi

  assumes "x>a<y>.P bz>  P'"

  shows False
using assms
by - (ind_cases "x>a<y>.P bz>  P'", auto simp add: pi.inject residualInject alpha')

lemma resOutputTauTrans[dest]:
  fixes x  :: name
  and   a  :: name
  and   b  :: name
  and   P  :: pi
  and   P' :: pi

  assumes "x>a{b}.P τ  P'"

  shows False
using assms
by - (ind_cases "x>a{b}.P τ  P'", auto simp add: residualInject pi.inject alpha')

lemma resOutputInputTrans[dest]:
  fixes x  :: name
  and   a  :: name
  and   b  :: name
  and   P  :: pi
  and   c  :: name
  and   y  :: name
  and   P' :: pi

  assumes "x>a{b}.P c<y>  P'"

  shows False
using assms
by - (ind_cases "x>a{b}.P c<y>  P'", auto simp add: pi.inject residualInject alpha')

lemma resOutputOutputTrans[dest]:
  fixes x  :: name
  and   a  :: name
  and   P  :: pi
  and   b  :: name
  and   y  :: name
  and   P' :: pi
  
  assumes "x>a{x}.P b[y]  P'"

  shows False
using assms
by - (ind_cases "x>a{x}.P b[y]  P'", auto simp add: pi.inject residualInject alpha' calc_atm)

lemma resTrans[dest]:
  fixes x  :: name
  and   b  :: name
  and   Rs :: residual
  and   y  :: name

  shows "x>x{b}.P  Rs  False"
  and   "x>x<y>.P  Rs  False"
apply(ind_cases "x>x{b}.P  Rs", auto simp add: pi.inject alpha' calc_atm)
by(ind_cases "x>x<y>.P  Rs", auto simp add: pi.inject alpha' calc_atm abs_fresh fresh_left)

lemma matchCases[consumes 1, case_names cMatch]:
  fixes a  :: name
  and   b  :: name
  and   P  :: pi
  and   Rs :: residual
  and   F  :: "name  name  bool"

  assumes "[ab]P  Rs"
  and     "P  Rs; a = b  F a a"

  shows "F a b"
using assms
by(induct rule: matchCases', auto)

lemma mismatchCases[consumes 1, case_names cMismatch]:
  fixes a  :: name
  and   b  :: name
  and   P  :: pi
  and   Rs :: residual
  and   F  :: "name  name  bool"

  assumes Trans:  "[ab]P  Rs"
  and     cMatch: "P  Rs; a  b  F a b"

  shows "F a b"
using assms
by(induct rule: mismatchCases', auto)

lemma sumCases[consumes 1, case_names cSum1 cSum2]:
  fixes P  :: pi
  and   Q  :: pi
  and   Rs :: residual

  assumes Trans: "P  Q  Rs"
  and     cSum1: "P  Rs  Prop"
  and     cSum2: "Q  Rs  Prop"

  shows Prop
using assms
by(induct rule: sumCases', auto)

lemma name_abs_alpha:
  fixes a :: name
  and   b :: name
  and   P :: pi
  
  assumes "b  P"

  shows "[a].P = [b].([(a, b)]  P)"
proof(cases "a=b", auto)
  assume "a  b"
  with assms show ?thesis
    by(force intro: abs_fun_eq3[OF pt_name_inst, OF at_name_inst]
             simp add: name_swap name_calc name_fresh_left)
qed

lemma parCasesB[consumes 3, case_names cPar1 cPar2]:
  fixes P   :: pi
  and   Q   :: pi
  and   a   :: subject
  and   x   :: name
  and   PQ' :: pi
  and   C   :: "'a::fs_name"
  
  assumes "P  Q  a«x»  PQ'"
  and     "x  P"
  and     "x  Q"
  and     "P'. P  a«x»  P'  Prop (P'  Q)"
  and     "Q'. Q  a«x»  Q'  Prop (P  Q')"

  shows "Prop PQ'"
proof -
  note assms
  moreover from P  Q a«x»  PQ' x  P x  Q have "x  a"
    by(force dest: freshBoundDerivative)
  moreover obtain y::name where "y  x" and "y  P" and "y  Q" and "y  a" and "y  PQ'" 
    by(generate_fresh "name", auto simp add: fresh_prod)
  moreover obtain z::name where "z  y" and "z  x" and "z  P" and "z  Q" and "z  a" and "z  PQ'" 
    by(generate_fresh "name", auto simp add: fresh_prod)
  ultimately show ?thesis
    by(cases rule: transitions.strong_cases[where x=y and b=y and xa=x and xb=x and xc=y and xd=y and xe=y
                                              and xf=y and xg=y and y=z and ya = z and yb=z and yc=z])
      (auto simp add: pi.inject residualInject alpha abs_fresh fresh_prod)+
qed


lemma parCasesF[consumes 1, case_names cPar1 cPar2 cComm1 cComm2 cClose1 cClose2]:
  fixes P  :: pi
  and   Q  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   C  :: "'a::fs_name"
  and   F  :: "freeRes  pi  bool"

  assumes Trans: "P  Q  α  PQ'"
  and     icPar1F: "P'. P  α  P'  F α (P'  Q)"
  and     icPar2F: "Q'. Q  α  Q'  F α (P  Q')"
  and     icComm1: "P' Q' a b x. P  a<x>  P'; Q  a[b]  Q'; x  P; x Q; x  a; x  b; x  Q'; x  C; α = τ  F (τ) (P'[x::=b]  Q')"
  and     icComm2: "P' Q' a b x. P  a[b]  P'; Q  a<x>  Q'; x  P; x  Q; x  a; x  b; x  P'; x  C; α = τ  F (τ) (P'  Q'[x::=b])"
  and     icClose1: "P' Q' a x y. P  a<x>  P'; Q  ay>  Q'; x  P; x  Q; x  a; x  y; x  Q'; y  P; y  Q; y  a; y  P'; x  C; y  C; α = τ  
                                     F (τ) (y>(P'[x::=y]  Q'))"
  and     icClose2: "P' Q' a x y. P  ay>  P'; Q  a<x>  Q'; x  P; x  Q; x  a; x  y; x  P'; y  P; y  Q; y  a; y  Q'; x  C; y  C; α = τ 
                                      F (τ) (y>(P'  Q'[x::=y]))"

  shows "F α PQ'"
proof -
  note assms
  moreover obtain x::name where "x  P" and "x  Q" and "x  α" and "x  PQ'" and "x  C"
    by(generate_fresh "name", auto simp add: fresh_prod)
  moreover obtain y::name where "y  P" and "y  Q" and "y  α" and "y  PQ'" and "y  C" and "x  y"
    by(generate_fresh "name", auto simp add: fresh_prod)
  ultimately show ?thesis
    by(cases rule: transitions.strong_cases[where x=x and b=x and xa=x and xb=x and xc=x and xd=x and xe=x
                                              and xf=x and xg=x and y=y and ya=y and yb=y and yc=y])
      (auto simp add: pi.inject residualInject alpha abs_fresh fresh_prod)+
qed

lemma resCasesF[consumes 1, case_names cRes]:
  fixes x  :: name
  and   P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   C  :: "'a::fs_name"

  assumes "x>P  α  xP'"
  and     "P'. P  α  P'; x  α  F (x>P')"

  shows "F xP'"
proof -
  note assms
  moreover from x>P α  xP' have "x  α" and "x  xP'"
    by(force dest: freshFreeDerivative simp add: abs_fresh)+
  moreover obtain y::name where "y  x" and "y  P" and "y  α" and "y  xP'" 
    by(generate_fresh "name", auto simp add: fresh_prod)
  moreover obtain z::name where "z  y" and "z  x" and "z  P" and "z  α" and "z  xP'" 
    by(generate_fresh "name", auto simp add: fresh_prod)
  ultimately show ?thesis
    by(cases rule: transitions.strong_cases[where x=y and b=y and xa=y and xb=y and xc=y and xd=y and xe=y
                                              and xf=y and xg=y and y=z and ya=z and yb=z and yc=x])
      (auto simp add: pi.inject residualInject alpha abs_fresh fresh_prod)+
qed

lemma resCasesB[consumes 3, case_names cOpen cRes]:
  fixes x :: name
  and   P  :: pi
  and   a  :: subject
  and   y :: name
  and   yP' :: pi
  and   C  :: "'a::fs_name"

  assumes Trans:  "y>P a«x»  yP'"
  and     xineqy: "x  y"
  and     xineqy: "x  P"
  and     rcOpen: "b P'. P b[y]  P'; b  y; a = BoundOutputS b  F (BoundOutputS b) ([(x, y)]  P')"
  and     rcResB: "P'. P  a«x»  P'; y  a  F a (y>P')"

  shows "F a yP'"
proof -
  note assms
  moreover from y>P a«x»  yP' x  y have "y  a" and "y  yP'"
    by(force dest: freshBoundDerivative simp add: abs_fresh)+
  moreover from  y>P a«x»  yP' x  P have "x  a"
    by(force dest: freshBoundDerivative simp add: abs_fresh)+
  moreover obtain z::name where "z  y" and "z  x" and "z  P" and "z  a" and "z  yP'" 
    by(generate_fresh "name", auto simp add: fresh_prod)
  moreover obtain z'::name where "z'  y" and "z'  x" and "z'  z" and "z'  P" and "z'  a" and "z'  yP'" 
    by(generate_fresh "name", auto simp add: fresh_prod)
  ultimately show ?thesis
    by(cases rule: transitions.strong_cases[where x=z and b=y and xa=z and xb=z and xc=z and xd=z and xe=z
                                              and xf=z and xg=x and y=z' and ya=z' and yb=y and yc=z'])
      (auto simp add: pi.inject residualInject alpha abs_fresh fresh_prod fresh_left calc_atm)+
qed

lemma bangInduct[consumes 1, case_names cPar1B cPar1F cPar2B cPar2F cComm1 cComm2 cClose1 cClose2 cBang]:
  fixes F  :: "'a::fs_name  pi  residual  bool"
  and   P  :: pi
  and   Rs :: residual
  and   C  :: "'a::fs_name"

  assumes Trans:  "!P  Rs"
  and     cPar1B: "a x P' C. P  a«x»  P'; x  P; x  C  F C (P  !P) (a«x»  P'  !P)"
  and     cPar1F: "α P' C. P  α  P'  F C (P  !P) (α  P'  !P)"
  and     cPar2B: "a x P' C. !P  a«x»  P'; x  P; x  C; C. F C (!P) (a«x»  P')  
                               F C (P  !P) (a«x»  P  P')"
  and     cPar2F: "α P' C. !P  α  P'; C. F C (!P) (α  P')  F C (P  !P) (α  P  P')"
  and     cComm1: "a x P' b P'' C. P  a<x>  P'; !P  (OutputR a b)  P''; x  C;
                                      C. F C (!P) ((OutputR a b)  P'') 
                                      F C (P  !P) (τ  (P'[x::=b])  P'')"
  and     cComm2: "a b P' x P'' C. P  (OutputR a b)  P'; !P  a<x>  P''; x  C; 
                                      C. F C (!P) (a<x>  P'') 
                                      F C (P  !P) (τ  P'  (P''[x::=b]))"
  and     cClose1: "a x P' y P'' C. P  a<x>  P'; !P  ay>  P''; y  P; x  C; y  C;
                                      C. F C (!P) (ay>  P'') 
                                      F C (P  !P) (τ  y>((P'[x::=y])  P''))"
  and     cClose2: "a y P' x P'' C. P  ay>  P'; !P  a<x>  P''; y  P; x  C; y  C;
                                       C. F C (!P) (a<x>  P'') 
                                       F C (P  !P) (τ  y>(P'  (P''[x::=y])))"
  and     cBang: "Rs C. P  !P  Rs; C. F C (P  !P) Rs  F C (!P) Rs"

  shows "F C (!P) Rs"
proof -
  have "X Y C. X  Y; bangPred P X  F C X Y"
  proof -
    fix X Y C
    assume "X  Y" and "bangPred P X"
    thus "F C X Y"
    proof(nominal_induct avoiding: C rule: transitions.strong_induct)
      case(Tau Pa)
      thus ?case
        apply -
        by(ind_cases "bangPred P (τ.(Pa))")
    next
      case(Input x a Pa)
      thus ?case
        apply -
        by(ind_cases "bangPred P (a<x>.Pa)")
    next
      case(Output a b Pa)
      thus ?case
        apply -
        by(ind_cases "bangPred P (a{b}.Pa)")
    next
      case(Match Pa Rs b)
      thus ?case
        apply -
        by(ind_cases "bangPred P ([bb]Pa)")
    next
      case(Mismatch Pa Rs a b)
      thus ?case
        apply -
        by(ind_cases "bangPred P ([ab]Pa)")
    next
      case(Open Pa a b Pa')
      thus ?case
        apply -
        by(ind_cases "bangPred P (b>Pa)")
    next
      case(Sum1 Pa Rs Q)
      thus ?case
        apply -
        by(ind_cases "bangPred P (Pa  Q)")
    next
      case(Sum2 Q Rs Pa)
      thus ?case
        apply -
        by(ind_cases "bangPred P (Pa  Q)")
    next
      case(Par1B Pa a x Pa' Q )
      thus ?case
        apply -
        by(ind_cases "bangPred P (Pa  Q)", auto intro: cPar1B simp add: pi.inject)
    next
      case(Par1F Pa α Pa' Q)
      thus ?case
        apply -
        by(ind_cases "bangPred P (Pa  Q)", auto intro: cPar1F simp add: pi.inject)
    next
      case(Par2B Qa a x Qa' Pa)
      thus ?case
        apply -
        by(ind_cases "bangPred P (Pa  Qa)", auto intro: cPar2B aux1 simp add: pi.inject)
    next
      case(Par2F Qa α Qa' Pa)
      thus ?case
        apply -
        by(ind_cases "bangPred P (Pa  Qa)", auto intro: cPar2F aux1 simp add: pi.inject)
    next
      case(Comm1 Pa a x Pa' Q b Q')
      thus ?case
        apply -
        by(ind_cases "bangPred P (Pa  Q)", auto intro: cComm1 aux1 simp add: pi.inject)
    next
      case(Comm2 Pa a b Pa' Q x Q')
      thus ?case
        apply -
        by(ind_cases "bangPred P (Pa  Q)", auto intro: cComm2 aux1 simp add: pi.inject)
    next
      case(Close1 Pa a x Pa' Q y Q')
      thus ?case
        apply -
        by(ind_cases "bangPred P (Pa  Q)", auto intro: cClose1 aux1 simp add: pi.inject)
    next
      case(Close2 Pa a y Pa' Q x Q')
      thus ?case
        apply -
        by(ind_cases "bangPred P (Pa  Q)", auto intro: cClose2 aux1 simp add: pi.inject)
    next
      case(ResB Pa a x P' y)
      thus ?case
        apply -
        by(ind_cases "bangPred P (y>Pa)")
    next
      case(ResF Pa α P' y)
      thus ?case
        apply -
        by(ind_cases "bangPred P (y>Pa)")
    next
      case(Bang Pa Rs)
      thus ?case
        apply -
        by(ind_cases "bangPred P (!Pa)", auto intro: cBang aux2 simp add: pi.inject)
    qed
  qed

  with Trans show ?thesis by(force intro: bangPred.aux1)
qed

end

Theory Late_Semantics1

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Late_Semantics1
  imports Late_Semantics
begin

free_constructors case_subject for
  InputS
| BoundOutputS
by(auto simp add: subject.inject)
  (metis Rep_subject_inverse subject.constr_rep(1,2) subject_Rep.exhaust)

free_constructors case_freeRes for
  OutputR
| TauR
by(auto simp add: freeRes.inject)
  (metis Abs_freeRes_cases Abs_freeRes_inverse freeRes.constr_rep(1,2) freeRes_Rep.exhaust)

end

Theory Rel

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Rel
  imports Agent
begin

definition eqvt :: "(('a::pt_name) × ('a::pt_name)) set  bool"
  where "eqvt Rel  (x (perm::name prm). x  Rel  perm  x  Rel)"

lemma eqvtRelI:
  fixes Rel  :: "('a::pt_name × 'a) set"
  and   P    :: 'a
  and   Q    :: 'a
  and   perm :: "name prm"

  assumes "eqvt Rel"
  and     "(P, Q)  Rel"

  shows "(perm  P, perm  Q)  Rel"
using assms
by(auto simp add: eqvt_def)

lemma eqvtRelE:
  fixes Rel  :: "('a::pt_name × 'a) set"
  and   P    :: 'a
  and   Q    :: 'a
  and   perm :: "name prm"

  assumes "eqvt Rel"
  and     "(perm  P, perm  Q)  Rel"

  shows "(P, Q)  Rel"
proof -
  have "rev perm  (perm  P) = P" and "rev perm  (perm  Q) = Q"
    by(simp add: pt_rev_pi[OF pt_name_inst, OF at_name_inst])+
  with assms show ?thesis
    by(force dest: eqvtRelI[of _ _ _ "rev perm"])
qed

lemma eqvtTrans[intro]:
  fixes Rel  :: "('a::pt_name × 'a) set"
  and   Rel' :: "('a × 'a) set"

  assumes EqvtRel:  "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "eqvt (Rel O Rel')"
using assms
by(force simp add: eqvt_def)

lemma eqvtUnion[intro]:
  fixes Rel  :: "('a::pt_name × 'a) set"
  and   Rel' :: "('a × 'a) set"

  assumes EqvtRel:  "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "eqvt (Rel  Rel')"
using assms
by(force simp add: eqvt_def)

definition substClosed :: "(pi × pi) set  (pi × pi) set" where
  "substClosed Rel  {(P, Q) | P Q. σ. (P[<σ>], Q[<σ>])  Rel}"

lemma eqvtSubstClosed:
  fixes Rel :: "(pi × pi) set"

  assumes eqvtRel: "eqvt Rel"

  shows "eqvt (substClosed Rel)"
proof(simp add: eqvt_def substClosed_def, auto)
  fix P Q perm s

  assume "s. (P[<s>], Q[<s>])  Rel"
  hence "(P[<(rev (perm::name prm)  s)>], Q[<(rev perm  s)>])  Rel" by simp
  with eqvtRel have "(perm  (P[<(rev perm  s)>]), perm  (Q[<(rev perm  s)>]))  Rel"
    by(rule eqvtRelI)
  thus "((perm  P)[<s>], (perm  Q)[<s>])  Rel"
    by(simp add: name_per_rev)
qed

lemma substClosedSubset:
  fixes Rel  :: "(pi × pi) set"

  shows "substClosed Rel  Rel"
proof(auto simp add: substClosed_def)
  fix P Q
  assume "s. (P[<s>], Q[<s>])  Rel"
  hence "(P[<[]>], Q[<[]>])  Rel" by blast
  thus "(P, Q)  Rel" by simp
qed

lemma partUnfold:
  fixes P   :: pi
  and   Q   :: pi
  and   σ   :: "(name × name) list"
  and   Rel :: "(pi × pi) set"

  assumes "(P, Q)  substClosed Rel"

  shows "(P[<σ>], Q[<σ>])  substClosed Rel"
using assms
proof(auto simp add: substClosed_def)
  fix σ'
  assume "σ. (P[<σ>], Q[<σ>])  Rel"
  hence "(P[<(σ@σ')>], Q[<(σ@σ')>])  Rel" by blast
  thus "((P[<σ>])[<σ'>], (Q[<σ>])[<σ'>])  Rel"
    by simp
qed

inductive_set bangRel :: "(pi × pi) set  (pi × pi) set"
for Rel :: "(pi × pi) set"
where
  BRBang: "(P, Q)  Rel  (!P, !Q)  bangRel Rel"
| BRPar: "(R, T)  Rel  (P, Q)  (bangRel Rel)  (R  P, T  Q)  (bangRel Rel)"
| BRRes: "(P, Q)  bangRel Rel  (a>P, a>Q)  bangRel Rel"

inductive_cases BRBangCases': "(P, !Q)  bangRel Rel"
inductive_cases BRParCases': "(P, Q  !Q)  bangRel Rel"
inductive_cases BRResCases': "(P, x>Q)  bangRel Rel"

lemma eqvtBangRel:
  fixes Rel :: "(pi × pi) set"

  assumes eqvtRel: "eqvt Rel"

  shows "eqvt(bangRel Rel)"
proof(simp add: eqvt_def, auto)
  fix P Q perm
  assume "(P, Q)  bangRel Rel"
  thus "((perm::name prm)  P, perm  Q)  bangRel Rel"
  proof(induct)
    fix P Q
    assume "(P, Q)  Rel"
    with eqvtRel have "(perm  P, perm  Q)  Rel"
      by(rule eqvtRelI)
    thus "(perm  !P, perm  !Q)  bangRel Rel"
      by(force intro: BRBang)
  next
    fix P Q R T
    assume R: "(R, T)  Rel"
    assume BR: "(perm  P, perm  Q)  bangRel Rel"

    from eqvtRel R have "(perm  R, perm  T)  Rel"
      by(rule eqvtRelI)

    with BR show "(perm  (R  P), perm  (T  Q))  bangRel Rel"
      by(force intro: BRPar)
  next
    fix P Q a
    assume "(perm  P, perm  Q)  bangRel Rel"
    thus "(perm  a>P, perm  a>Q)  bangRel Rel"
      by(force intro: BRRes)
  qed
qed

lemma BRBangCases[consumes 1, case_names BRBang]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   F   :: "pi  bool"

  assumes "(P, !Q)  bangRel Rel"
  and     "P. (P, Q)  Rel  F (!P)"
  
  shows "F P"
using assms
by(induct rule: BRBangCases', auto simp add: pi.inject)

lemma BRParCases[consumes 1, case_names BRPar]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   F   :: "pi  bool"

  assumes "(P, Q  !Q)  bangRel Rel"
  and     "P R. (P, Q)  Rel; (R, !Q)  bangRel Rel  F (P  R)"

  shows "F P"
using assms
by(induct rule: BRParCases', auto simp add: pi.inject)

lemma bangRelSubset:
  fixes Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes "(P, Q)  bangRel Rel"
  and     "P Q. (P, Q)  Rel  (P, Q)  Rel'"

  shows "(P, Q)  bangRel Rel'"
using assms
by(induct rule:  bangRel.induct) (auto intro: BRBang BRPar BRRes)

lemma bangRelSymetric: 
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"

  assumes A:   "(P, Q)  bangRel Rel"
  and     Sym: "P Q. (P, Q)  Rel  (Q, P)  Rel"

  shows "(Q, P)  bangRel Rel"
proof -
  from A show ?thesis
  proof(induct)
    fix P Q
    assume "(P, Q)  Rel"
    hence "(Q, P)  Rel" by(rule Sym)
    thus "(!Q, !P)  bangRel Rel" by(rule BRBang)
  next
    fix P Q R T
    assume RRelT: "(R, T)  Rel"
    assume IH: "(Q, P)  bangRel Rel"
    from RRelT have "(T, R)  Rel" by(rule Sym)
    thus "(T  Q, R  P)  bangRel Rel" using IH by(rule BRPar)
  next
    fix P Q a
    assume "(Q, P)  bangRel Rel"
    thus "(a>Q, a>P)  bangRel Rel" by(rule BRRes)
  qed
qed

primrec resChain :: "name list  pi  pi" where
   base: "resChain [] P = P"
 | step: "resChain (x#xs) P = x>(resChain xs P)"

lemma resChainPerm[simp]:
  fixes perm :: "name prm"
  and   lst  :: "name list"
  and   P    :: pi
  
  shows "perm  (resChain lst P) = resChain (perm  lst) (perm  P)"
by(induct_tac lst, auto)

lemma resChainFresh:
  fixes a   :: name
  and   lst :: "name list"
  and   P   :: pi

  assumes "a  (lst, P)"

  shows "a  (resChain lst P)"
using assms apply(induct_tac lst)
apply(simp add: fresh_prod)
by(simp add: fresh_prod name_fresh_abs)

end

Theory Strong_Late_Sim

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Sim
  imports Late_Semantics1 Rel
begin

definition derivative :: "pi  pi  subject  name  (pi × pi) set  bool" where
  "derivative P Q a x Rel  case a of InputS b  (u. (P[x::=u], Q[x::=u])  Rel)
                                    | BoundOutputS b  (P, Q)  Rel"

definition simulation :: "pi  (pi × pi) set  pi  bool" ("_ ↝[_] _" [80, 80, 80] 80) where
  "P ↝[Rel] Q  (a x Q'. Q a«x»  Q'  x  P  (P'. P a«x»  P'  derivative P' Q' a x Rel)) 
                 (α Q'. Q α  Q'  (P'. P α  P'  (P', Q')  Rel))"

lemma monotonic: 
  fixes A  :: "(pi × pi) set"
  and   B  :: "(pi × pi) set"
  and   P  :: pi
  and   P' :: pi

  assumes "P ↝[A] P'"
  and     "A  B"

  shows "P ↝[B] P'"
using assms
apply(auto simp add: simulation_def derivative_def)
by(case_tac a) fastforce+

lemma derivativeMonotonic:
  fixes A :: "(pi × pi) set"
  and   B :: "(pi × pi) set"
  and   P :: pi
  and   Q :: pi
  and   a :: subject
  and   x :: name

  assumes "derivative P Q a x A"
  and     "A  B"
  
  shows "derivative P Q a x B"
using assms
by(case_tac a, auto simp add: derivative_def)

lemma derivativeEqvtI:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: subject
  and   x    :: name
  and   Rel  :: "(pi × pi) set"
  and   perm :: "name prm"

  assumes Der: "derivative P Q a x Rel"
  and     Eqvt: "eqvt Rel"
  
  shows "derivative (perm  P) (perm  Q) (perm  a) (perm  x) Rel"
using assms
apply(case_tac a, auto simp add: derivative_def)
apply(erule_tac x="rev perm  u" in allE)
apply(drule_tac perm=perm in eqvtRelI)
apply(blast)
apply(force simp add: eqvt_subs name_per_rev)
by(force simp add: eqvt_def)

lemma derivativeEqvtI2:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: subject
  and   x    :: name
  and   Rel  :: "(pi × pi) set"
  and   perm :: "name prm"

  assumes Der: "derivative P Q a x Rel"
  and     Eqvt: "eqvt Rel"
  
  shows "derivative (perm  P) (perm  Q) a (perm  x) Rel"
using assms
apply(case_tac a, auto simp add: derivative_def)
apply(erule_tac x="rev perm  u" in allE)
apply(drule_tac perm=perm in eqvtRelI)
apply(blast)
apply(force simp add: eqvt_subs name_per_rev)
by(force simp add: eqvt_def)

lemma freshUnit[simp]:
  fixes y :: name

  shows "y  ()"
by(auto simp add: fresh_def supp_unit)

lemma simCasesCont[consumes 1, case_names Bound Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   C   :: "'a::fs_name"

  assumes Eqvt:  "eqvt Rel"
  and     Bound: "a x Q'. Q  a«x»  Q'; x  P; x  Q; x  a; x  C  P'. P  a«x»  P'  derivative P' Q' a x Rel"
  and     Free:  "α Q'. Q  α  Q'  P'. P  α  P'  (P', Q')  Rel"

  shows "P ↝[Rel] Q"
using Free
proof(auto simp add: simulation_def)
  fix a x Q'
  assume "(x::name)  P"
  assume Trans: "Q  a«x»  Q'"
  
  obtain y::name where "y  P" and "y  Q" and "y  a" and "y  C" and "y  Q'" and "y  x"
    by(generate_fresh "name") auto

  from Trans y  Q' have "Q  a«y»  [(x, y)]  Q'" by(simp add: alphaBoundResidual)
  hence "P'. P  a«y»  P'  derivative P' ([(x, y)]  Q') a y Rel" 
    using y  P y  Q y  a y  C
    by(rule Bound)
  then obtain P' where PTrans: "P  a«y»  P'" and PDer: "derivative P' ([(x, y)]  Q') a y Rel"
    by blast
  
  from PTrans x  P y  x have "x  P'" by(force intro: freshBoundDerivative)
  with PTrans have "P  a«x»  [(x, y)]  P'" by(simp add: alphaBoundResidual name_swap)
  moreover have "derivative ([(x, y)]  P') Q' a x Rel"
  proof -
    from PDer Eqvt have "derivative ([(x, y)]  P') ([(x, y)]  [(x, y)]  Q') a ([(x, y)]  y) Rel"
      by(rule derivativeEqvtI2)
    with y  x show ?thesis by(simp add: name_calc)
  qed
  ultimately show "P'. P a«x»  P'  derivative P' Q' a x Rel" by blast
qed

lemma simCases[case_names Bound Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Bound: "a y Q'. Q  a«y»  Q'; y  P  P'. P  a«y»  P'  derivative P' Q' a y Rel"
  and     Free:  "α Q'. Q  α  Q'  P'. P  α  P'  (P', Q')  Rel"

  shows "P ↝[Rel] Q"
using assms
by(auto simp add: simulation_def)

lemma resSimCases[consumes 1, case_names BoundOutput BoundR FreeR]:
  fixes x   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   C   :: "'a::fs_name"

  assumes Eqvt:    "eqvt Rel"
  and     BoundO:  "Q' a. Q a[x]  Q'; a  x  P'. P ax>  P'  (P', Q')  Rel"
  and     BR:      "Q' a y. Q a«y»  Q'; x  a; x  y; y  C  P'. P a«y»  P'  derivative P' (x>Q') a y Rel"
  and     BF:      "Q' α. Q α  Q'; x  α  P'. P α  P'  (P', x>Q')  Rel"

  shows "P ↝[Rel] x>Q"
using Eqvt
proof(induct rule: simCasesCont[where C="(C, x, Q)"])
  case(Bound a y Q')
  have "y  (C, x, Q)" by fact
  hence yFreshC: "y  C" and yineqx: "y  x" and "y  Q"
    by(simp add: fresh_prod)+
  have "x>Q a«y»  Q'" by fact
  thus ?case using yineqx y  Q
  proof(induct rule: resCasesB)
    case(cOpen a' Q')
    have "Q a'[x]  Q'" and "a'  x" by fact+
    then obtain P' where PTrans: "P a'x>  P'" and P'RelQ': "(P', Q')  Rel" by(force dest: BoundO)
    
    from PTrans y  P yineqx have "y  P'" by(force dest: freshBoundDerivative)
    with PTrans have "P a'y>  ([(x, y)]  P')" by(simp add: alphaBoundResidual)
    moreover from P'RelQ' Eqvt have "([(x, y)]  P', [(x, y)]  Q')  Rel" by(auto simp add: eqvt_def)
    ultimately show ?case by(force simp add: derivative_def name_swap) 
  next
    case(cRes Q')
    have "Q a«y»  Q'" and "x  a" by fact+
    with yineqx yFreshC show ?case by(force dest: BR)
  qed
next
  case(Free α Q')
  have "x>Q α  Q'" by fact
  thus ?case
  proof(induct rule: resCasesF)
    case(cRes Q')
    have "Q α  Q'" and "x  α" by fact+
    thus ?case by(rule BF)
  qed
qed

lemma simE:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   a   :: subject
  and   x   :: name
  and   Q'  :: pi

  assumes "P ↝[Rel] Q"

  shows "Q  a«x»  Q'  x  P  P'. P  a«x»  P'  (derivative P' Q' a x Rel)"
  and   "Q  α  Q'  P'. P  α  P'  (P', Q')  Rel"
using assms by(simp add: simulation_def)+

lemma eqvtI:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   perm :: "name prm"

  assumes Sim: "P ↝[Rel] Q"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel': "eqvt Rel'"

  shows "(perm  P) ↝[Rel'] (perm  Q)"
proof(induct rule: simCases)
  case(Bound a y Q')
  have QTrans: "(perm  Q)  a«y»  Q'" and yFreshP: "y  perm  P" by fact+
  
  from QTrans have "(rev perm  (perm  Q))  rev perm  (a«y»  Q')"
    by(rule transitions.eqvt)
  hence "Q  (rev perm  a)«(rev perm  y)»  (rev perm  Q')" 
    by(simp add: name_rev_per)
  moreover from yFreshP have "(rev perm  y)  P" by(simp add: name_fresh_left)
  ultimately have "P'. P  (rev perm  a)«rev perm  y»  P'  derivative P' (rev perm  Q') (rev perm  a) (rev perm  y) Rel" using Sim
    by(force intro: simE)
  then obtain P' where PTrans: "P  (rev perm  a)«rev perm  y»  P'" and Pderivative: "derivative P' (rev perm  Q') (rev perm  a) (rev perm  y) Rel" by blast
  
  from PTrans have "(perm  P)  perm  ((rev perm  a)«rev perm  y»  P')" by(rule transitions.eqvt)
  hence L1: "(perm  P)  a«y»  (perm  P')" by(simp add: name_per_rev)
  from Pderivative RelRel' have "derivative P' (rev perm  Q') (rev perm  a) (rev perm  y) Rel'"
    by(rule derivativeMonotonic)
  hence "derivative (perm  P') (perm  (rev perm  Q')) (perm  (rev perm  a)) (perm  (rev perm  y)) Rel'" using EqvtRel'
    by(rule derivativeEqvtI)
  hence "derivative (perm  P') Q' a y Rel'" by(simp add: name_per_rev)
  with L1 show ?case by blast
next
  case(Free α Q')
  have "(perm  Q)  α  Q'" by fact

  hence "(rev perm  (perm  Q))  rev perm  (α  Q')"
    by(rule transitions.eqvt)
  hence "Q  (rev perm  α)  (rev perm  Q')" 
    by(simp add: name_rev_per)
  with Sim have "P'. P  (rev perm  α)  P'  (P', (rev perm  Q'))  Rel"
    by(force intro: simE)
  then obtain P' where PTrans: "P  (rev perm  α)  P'" and PRel: "(P', (rev perm  Q'))  Rel"
    by blast
    
  from PTrans have "(perm  P)  perm  ((rev perm  α) P')" by(rule transitions.eqvt)
  hence L1: "(perm  P)  α  (perm  P')" by(simp add: name_per_rev)
  from PRel EqvtRel' RelRel'  have "((perm  P'), (perm  (rev perm  Q')))  Rel'"
    by(force intro: eqvtRelI)
  hence "((perm  P'), Q')  Rel'" by(simp add: name_per_rev)
  with L1 show "P'. (perm  P) α  P'  (P', Q')  Rel'" by blast
qed

lemma derivativeReflexive:
  fixes P   :: pi
  and   a   :: subject
  and   x   :: name
  and   Rel :: "(pi × pi) set"
  
  assumes "Id  Rel"

  shows "derivative P P a x Rel"
using assms
apply(cases a)
by(auto simp add: derivative_def)
(*
lemma simActFreeCases[consumes 0, case_names Der]:
  fixes P   :: pi
  and   α   :: freeRes
  and   Q'  :: pi
  and   Rel :: "(pi × pi) set"

  assumes "∃P'. P ⟼α ≺ P' ∧ (P', Q') ∈ Rel"

  shows "simAct P (α ≺ Q') P Rel"
using assms
by(simp add: simAct_def residualInject)
*)
(*****************Reflexivity and transitivity*********************)

lemma reflexive:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "P ↝[Rel] P"
using assms
by(auto simp add: simulation_def derivativeReflexive)

lemma transitive:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"
  and     QSimR: "Q ↝[Rel'] R"
  and     Eqvt': "eqvt Rel''"
  and     Trans: "Rel O Rel'  Rel''"

  shows "P ↝[Rel''] R"
using Eqvt'
proof(induct rule: simCasesCont[where C=Q])
  case(Bound a x R')
  have RTrans: "R  a«x»  R'" by fact

  from x  Q QSimR RTrans obtain Q' where QTrans: "Q  a«x»  Q'"
                                        and QDer: "derivative Q' R' a x Rel'" 
    by(blast dest: simE)
  with QTrans x  P PSimQ obtain P' where PTrans: "P  a«x»  P'"
                                        and PDer: "derivative P' Q' a x Rel"
    by(blast dest: simE)
  moreover from PDer QDer Trans have "derivative P' R' a x Rel''"
    by(cases a) (auto simp add: derivative_def)
  ultimately show ?case by blast
next
  case(Free α R')
  have RTrans: "R  α  R'" by fact
  with QSimR obtain Q' where QTrans: "Q  α  Q'" 
                         and Q'RelR': "(Q', R')  Rel'"
    by(blast dest: simE)
  from QTrans PSimQ obtain P' where PTrans: "P  α  P'"
                                and P'RelQ': "(P', Q')  Rel"
    by(blast dest: simE)
  from P'RelQ' Q'RelR' Trans have "(P', R')  Rel''" by blast
  with PTrans show ?case by blast
qed

end

Theory Strong_Late_Bisim

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Bisim
  imports Strong_Late_Sim
begin

lemma monoAux: "A  B  P ↝[A] Q  P ↝[B] Q"
by(auto intro: Strong_Late_Sim.monotonic)

coinductive_set bisim :: "(pi × pi) set"
where
  step: "P ↝[bisim] Q; (Q, P)  bisim  (P, Q)  bisim"
monos monoAux

abbreviation
  strongBisimJudge (infixr "" 65) where "P  Q  (P, Q)  bisim"

lemma monotonic': "mono(λS. {(P, Q) |P Q. P ↝[S] Q  Q ↝[S] P})"
apply(rule monoI)
by(auto dest: monoAux)

lemma monotonic: "mono(λp x1 x2.
        P Q. x1 = P 
              x2 = Q  P ↝[{(xa, x). p xa x}] Q  Q ↝[{(xa, x). p xa x}] P)"
apply(rule monoI)
by(auto intro: Strong_Late_Sim.monotonic)


lemma bisimCoinduct[case_names cSim cSym , consumes 1]:
  assumes p: "(P, Q)  X"
  and     rSim: "R S. (R, S)  X  R ↝[(X  bisim)] S"
  and     rSym: "R S. (R, S)  X  (S, R)  X"

  shows "P  Q"
proof -
  have aux: "X  bisim = {(P, Q). (P, Q)  X  P  Q}" by blast

  from p show ?thesis
    apply(coinduct, auto)
    apply(fastforce dest: rSim simp add: aux)
    by(fastforce dest: rSym)
qed

lemma bisimE:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"
  
  shows "P ↝[bisim] Q"
using assms
by(auto intro: bisim.cases)

lemma bisimI:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P ↝[bisim] Q"
  and     "Q  P"

  shows "P  Q"
using assms
by(rule bisim.intros)

definition old_bisim :: "(pi × pi) set  bool" where
  "old_bisim Rel  (P, Q)  Rel. P ↝[Rel] Q  (Q, P)  Rel"

lemma oldBisimBisimEq:
  shows "({Rel. (old_bisim Rel)}) = bisim"  (is "?LHS = ?RHS")
proof
  show "?LHS  ?RHS"
  proof auto
    fix P Q Rel
    assume "(P, Q)  Rel" and "old_bisim Rel"
    thus "P  Q"
    proof(coinduct rule: bisimCoinduct)
      case(cSim P Q)
      with ‹old_bisim Rel show ?case
        by(fastforce simp add: old_bisim_def intro: Strong_Late_Sim.monotonic)
    next
      case(cSym P Q)
      with ‹old_bisim Rel show ?case
        by(auto simp add: old_bisim_def)
    qed
  qed
next
  show "?RHS  ?LHS"
  proof auto
    fix P Q
    assume "P  Q"
    moreover hence "old_bisim bisim"
      by(auto simp add: old_bisim_def dest: bisim.cases)
    ultimately show "Rel. old_bisim Rel  (P, Q)  Rel"
      by blast
  qed
qed

lemma reflexive:
  fixes P :: pi

  shows "P  P"
proof -
  have "(P, P)  Id" by simp
  thus ?thesis
    by(coinduct rule: bisimCoinduct, auto intro: Strong_Late_Sim.reflexive)
qed

lemma symmetric:
  fixes P :: pi
  and   Q :: pi
   
  assumes "P  Q"

  shows "Q  P"
using assms
by(auto dest: bisim.cases)

lemma bisimClosed:
  fixes P :: pi
  and   Q :: pi
  and   p :: "name prm"
  
  assumes "P  Q"

  shows "(p  P)  (p  Q)" 
proof -
  let ?X = "{(p  P, p  Q) | P Q (p::name prm). P  Q}"
  from P  Q have  "(p  P, p  Q)  ?X" by blast
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim pP pQ)
    from (pP, pQ)  ?X obtain P Q p where "P  Q" and "pP = (p::name prm)  P" and "pQ = p  Q"
      by auto
    from P  Q have "P ↝[bisim] Q" by(rule bisimE)
    moreover have "bisim  ?X"
    proof 
      fix x
      assume "x  bisim"
      moreover have "x = (([]::name prm)  x)" by auto
      ultimately show "x  ?X"
        apply(case_tac x)
        by(clarify, simp only: eqvts) metis
    qed
    moreover have "eqvt ?X"
    proof(auto simp add: eqvt_def)
      fix P Q
      fix perm1::"name prm"
      fix perm2::"name prm"
      
      assume "P  Q"
      moreover have "perm1  perm2  P = (perm1 @ perm2)  P" by(simp add: pt2[OF pt_name_inst])
      moreover have "perm1  perm2  Q = (perm1 @ perm2)  Q" by(simp add: pt2[OF pt_name_inst])
      
      ultimately show "P' Q'. ((perm::name prm). perm1  perm2  P = perm  P' 
                                                   perm1  perm2  Q = perm  Q')  P'  Q'"
        by blast
    qed
    ultimately have "(p  P) ↝[?X] (p  Q)" 
      by(rule Strong_Late_Sim.eqvtI)
    with pP = p  P pQ = p  Q show ?case
      by(force intro: Strong_Late_Sim.monotonic)
  next
    case(cSym P Q)
    thus ?case by(auto intro: symmetric)
  qed
qed

lemma bisimEqvt[simp]:
  shows "eqvt bisim"
by(auto simp add: eqvt_def bisimClosed)

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P  Q"
  and     "Q  R"

  shows "P  R"
proof -
  let ?X = "bisim O bisim"
  from assms have "(P, R)  ?X" by blast
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim P R)
    thus ?case
      by(fastforce intro: Strong_Late_Sim.transitive dest: bisimE simp add: eqvtTrans)
  next
    case(cSym P R)
    thus ?case
      by(auto dest: symmetric)
  qed
qed

lemma bisimTransitiveCoinduct[case_names cSim cSym, case_conclusion bisim step, consumes 2]:
  assumes "(P, Q)  X"
  and "eqvt X"
  and rSim: "R S. (R, S)  X  R ↝[(bisim O (X  bisim) O bisim)] S"
  and rSym: "R S. (R, S)  X  (S, R)  bisim O (X  bisim) O bisim"

  shows "P  Q"
proof -
  let ?X = "bisim O (X  bisim) O bisim"
  from (P, Q)  X  have "(P, Q)  ?X" by(auto intro: reflexive)
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim P Q)
    {
      fix P P' Q' Q

      assume "P  P'" and "(P', Q')  X  bisim" and "Q'  Q"
      have "P ↝[(?X  bisim)] Q"
      proof(cases "(P', Q')  X")
        case True
        from P  P' have "P ↝[bisim] P'" by(rule bisimE)
        moreover from (P', Q')  X have "P' ↝[(?X)] Q'" by(rule rSim)
        moreover from ‹eqvt X bisimEqvt have "eqvt(?X  bisim)" by blast
        moreover have "bisim O ?X  ?X  bisim" by(auto dest: transitive)
        ultimately have "P ↝[(?X  bisim)] Q'" by(rule Strong_Late_Sim.transitive)
        moreover from Q'  Q have "Q' ↝[bisim] Q" by(rule bisimE)
        moreover note ‹eqvt(?X  bisim)
        moreover have "(?X  bisim) O bisim  ?X  bisim"
          by auto (blast dest: transitive)+
        ultimately show ?thesis by(rule Strong_Late_Sim.transitive)
      next
        case False
        from (P', Q')  X (P', Q')  X  bisim› have "P'  Q'" by simp
        with P  P' Q'  Q have "P  Q" by(blast dest: transitive)
        hence "P ↝[bisim] Q" by(rule bisimE)
        moreover have "bisim  ?X  bisim" by auto
        ultimately show ?thesis by(rule Strong_Late_Sim.monotonic)
      qed
    }
    with (P, Q)  ?X show ?case by auto
    case(cSym P Q)
    {
      fix P P' Q' Q

      assume "P  P'" and "(P', Q')  X  bisim" and "Q'  Q"
      have "(Q, P)  bisim O (X  bisim) O bisim"
      proof(cases "(P', Q')  X")
        case True
        from (P', Q')  X have "(Q', P')  ?X" by(rule rSym)
        then obtain Q'' P'' where "Q'  Q''" and "(Q'', P'')  X  bisim" and "P''  P'"
          by auto
        from Q'  Q Q'  Q'' have "Q  Q''" by(metis transitive symmetric)
        moreover from P  P' P''  P' have "P''  P" by(metis transitive symmetric)
        ultimately show ?thesis using (Q'', P'')  X  bisim› by blast
      next
        case False
        from (P', Q')  X (P', Q')  X  bisim› have "P'  Q'" by simp
        with P  P' Q'  Q have "Q  P" by(metis transitive symmetric)
        thus ?thesis by(blast intro: reflexive)
      qed
    }
    with (P, Q)  ?X show ?case by blast
  qed
qed

end

Theory Strong_Late_Bisim_Subst

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Bisim_Subst
  imports Strong_Late_Bisim
begin

abbreviation
  StrongEqJudge (infixr "s" 65) where "P s Q  (P, Q)  (substClosed bisim)"


lemma congBisim:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"

  shows "P  Q"
using assms substClosedSubset by blast

lemma eqvt:
  shows "eqvt (substClosed bisim)"
by(rule eqvtSubstClosed[OF Strong_Late_Bisim.bisimEqvt])

lemma eqClosed:
  fixes P :: pi
  and   Q :: pi
  and   perm :: "name prm"

  assumes "P s Q"

  shows "(perm  P) s (perm  Q)"
using assms
by(rule eqvtRelI[OF eqvt])

lemma reflexive:
  fixes P :: pi
  
  shows "P s P"
by(force simp add: substClosed_def intro: Strong_Late_Bisim.reflexive)

lemma symmetric:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"
  
  shows "Q s P"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim.symmetric)

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  assumes "P s Q"
  and     "Q s R"
  
  shows "P s R"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim.transitive)

end

Theory Strong_Late_Sim_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Sim_Pres
  imports Strong_Late_Sim
begin

lemma tauPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "τ.(P) ↝[Rel] τ.(Q)"
proof -
  show "τ.(P) ↝[Rel] τ.(Q)"
  proof(induct rule: simCases)
    case(Bound a x Q')
    have "τ.(Q)  a«x»  Q'" by fact
    hence False by auto
    thus ?case by simp
  next
    case(Free α Q')
    have "τ.(Q)  α  Q'" by fact
    thus ?case
    proof(induct rule: tauCases)
      case cTau
      have "τ.(P)  τ  P" by(rule Late_Semantics.Tau)
      with PRelQ show ?case by blast
    qed
  qed
qed

lemma inputPres:
  fixes P    :: pi
  and   x    :: name
  and   Q    :: pi
  and   a    :: name
  and   Rel  :: "(pi × pi) set"

  assumes PRelQ: "y. (P[x::=y], Q[x::=y])  Rel"
  and     Eqvt: "eqvt Rel"

  shows "a<x>.P ↝[Rel] a<x>.Q"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, a, P, Q)"])
  case(Bound b y Q')
  from y  (x, a, P, Q) have "y  x" "y  a" "y  P" "y  Q" by simp+
  from a<x>.Q b«y»  Q' y  a y  x y  Q show ?case
  proof(induct rule: inputCases)
    case cInput
    
    have "a<x>.P  a<x>  P" by(rule Input) 
    hence "a<x>.P  a<y>  ([(x, y)]  P)" using y  P
      by(simp add: alphaBoundResidual)

    moreover have "derivative ([(x, y)]  P) ([(x, y)]  Q) (InputS a) y Rel"
    proof(auto simp add: derivative_def)
      fix u
      show "(([(x, y)]  P)[y::=u], ([(x, y)]  Q)[y::=u])  Rel"
      proof(cases "y=u")
        assume "y = u"
        moreover have "([(y, x)]  P, [(y, x)]  Q)  Rel"
        proof -
          from PRelQ have "(P[x::=x], Q[x::=x])  Rel" by blast
          hence "(P, Q)  Rel" by simp
          with Eqvt show ?thesis by(rule eqvtRelI)
        qed
        ultimately show ?thesis by simp
      next
        assume yinequ: "y  u"
        show ?thesis
        proof(cases "x = u")
          assume "x = u"
          moreover have "(([(y, x)]  P)[y::=x], ([(y, x)]  Q)[y::=x])  Rel"
          proof -
            from PRelQ have "(P[x::=y], Q[x::=y])  Rel" by blast
            with Eqvt have "([(y, x)]  (P[x::=y]), [(y, x)]  (Q[x::=y]))  Rel"
              by(rule eqvtRelI)
            with y  x show ?thesis
              by(simp add: eqvt_subs name_calc)
          qed
          ultimately show ?thesis by simp
        next
          assume xinequ: "x  u"
          hence "(([(y, x)]  P)[y::=u], ([(y, x)]  Q)[y::=u])  Rel"
          proof -
            from PRelQ have "(P[x::=u], Q[x::=u])  Rel" by blast
            with Eqvt have "([(y, x)]  (P[x::=u]), [(y, x)]  (Q[x::=u]))  Rel"
              by(rule eqvtRelI)
            with y  x  xinequ yinequ show ?thesis
              by(simp add: eqvt_subs name_calc)
          qed
          thus ?thesis by simp
        qed
      qed
    qed
    
    ultimately show ?case by blast
  qed
next
  case(Free α Q')
  have "a<x>.Q  α  Q'" by fact
  hence False by auto
  thus ?case by blast
qed

lemma outputPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "a{b}.P ↝[Rel] a{b}.Q"
proof -
  show ?thesis
  proof(induct rule: simCases)
    case(Bound c x Q')
    have "a{b}.Q  c«x»  Q'" by fact
    hence False by auto
    thus ?case by simp
  next
    case(Free α Q')
    have "a{b}.Q  α  Q'" by fact
    thus ?case
    proof(induct rule: outputCases)
      case cOutput
      have "a{b}.P  a[b]  P" by(rule Late_Semantics.Output)
      with PRelQ show ?case by blast
    qed
  qed
qed

lemma matchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"
  and     "Rel  Rel'"

  shows "[ab]P ↝[Rel'] [ab]Q"
proof -
  show ?thesis
  proof(induct rule: simCases)
    case(Bound c x Q')
    have "x   [ab]P" by fact
    hence xFreshP: "x  P" by simp
    have "[ab]Q  c«x»  Q'" by fact
    thus ?case
    proof(induct rule: matchCases)
      case cMatch
      have "Q c«x»  Q'" by fact
      with PSimQ xFreshP obtain P' where PTrans: "P c«x»  P'"
                                     and Pderivative: "derivative P' Q' c x Rel"
        by(blast dest: simE)

      from PTrans have "[aa]P  c«x»  P'" by(rule Late_Semantics.Match)
      moreover from Pderivative Rel  Rel' have "derivative P' Q' c x Rel'"
        by(cases c) (auto simp add: derivative_def)
      ultimately show ?case by blast
    qed
  next
    case(Free α Q')
    have "[ab]Q α  Q'" by fact
    thus ?case
    proof(induct rule: matchCases)
      case cMatch
      have "Q  α  Q'" by fact
      with PSimQ obtain P' where PTrans: "P  α  P'"
                             and PRel: "(P', Q')  Rel"
          by(blast dest: simE)
      from PTrans have "[aa]P α  P'" by(rule Late_Semantics.Match)
      with PRel Rel  Rel' show ?case by blast
    qed
  qed
qed

lemma mismatchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"
  and     "Rel  Rel'"

  shows "[ab]P ↝[Rel'] [ab]Q"
proof(induct rule: simCases)
  case(Bound c x Q')
  have "x  [ab]P" by fact
  hence xFreshP: "x  P" by simp
  from [ab]Q  c«x»  Q' show ?case
  proof(induct rule: mismatchCases)
    case cMismatch
    have "Q c«x»  Q'" by fact
    with PSimQ xFreshP obtain P' where PTrans: "P c«x»  P'"
                                   and Pderivative: "derivative P' Q' c x Rel"
      by(blast dest: simE)

    from PTrans a  b have "[ab]P  c«x»  P'" by(rule Late_Semantics.Mismatch)
    moreover from Pderivative Rel  Rel' have "derivative P' Q' c x Rel'"
      by(cases c) (auto simp add: derivative_def)
    ultimately show ?case by blast
  qed
next
  case(Free α Q')
  have "[ab]Q α  Q'" by fact
  thus ?case
  proof(induct rule: mismatchCases)
    case cMismatch
    have "Q  α  Q'" by fact
    with PSimQ obtain P' where PTrans: "P  α  P'"
                           and PRel: "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans a  b have "[ab]P α  P'" by(rule Late_Semantics.Mismatch)
    with PRel Rel  Rel' show ?case by blast
  qed
qed

lemma sumPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes PSimQ: "P ↝[Rel] Q"
  and     "Id  Rel'"
  and     "Rel  Rel'"

  shows "P  R ↝[Rel'] Q  R"
proof -
  show ?thesis
  proof(induct rule: simCases)
    case(Bound a x QR)
    have "x  P  R" by fact
    hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
    have "Q  R a«x»  QR" by fact
    thus ?case
    proof(induct rule: sumCases)
      case cSum1
      have "Q a«x»  QR" by fact
      with xFreshP PSimQ obtain P' where PTrans: "P a«x»  P'"
                                     and Pderivative: "derivative P' QR a x Rel"
        by(blast dest: simE)

      from PTrans have "P  R a«x»  P'" by(rule Late_Semantics.Sum1)
      moreover from Pderivative Rel  Rel' have "derivative P' QR a x Rel'"
        by(cases a) (auto simp add: derivative_def)
      ultimately show ?case by blast
    next
      case cSum2
      from R a«x»  QR have "P  R a«x»  QR" by(rule Sum2)
      thus ?case using ‹Id  Rel' by(blast intro: derivativeReflexive)
    qed
  next
    case(Free α QR)
    have "Q  R α  QR" by fact
    thus ?case
    proof(induct rule: sumCases)
      case cSum1
      have "Q α  QR" by fact
      with PSimQ obtain P' where PTrans: "P α  P'" and PRel: "(P', QR)  Rel" 
        by(blast dest: simE)
      from PTrans have "P  R α  P'" by(rule Late_Semantics.Sum1)
      with PRel Rel  Rel' show ?case by blast
    next
      case cSum2
      from R α  QR have "P  R α  QR" by(rule Sum2)
      thus ?case using ‹Id  Rel' by(blast intro: derivativeReflexive)
    qed
  qed
qed
      
lemma parCompose:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   T     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"
  
  assumes PSimQ:    "P ↝[Rel] Q"
  and     RSimT:    "R ↝[Rel'] T"
  and     PRelQ:    "(P, Q)  Rel"
  and     RRel'T:   "(R, T)  Rel'"
  and     Par:      "P Q R T. (P, Q)  Rel; (R, T)  Rel'  (P  R, Q  T)  Rel''"
  and     Res:      "P Q a. (P, Q)  Rel''  (a>P, a>Q)  Rel''"
  and     EqvtRel:  "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"
  and     EqvtRel'': "eqvt Rel''"

  shows "P  R ↝[Rel''] Q  T"
using EqvtRel''
proof(induct rule: simCasesCont[where C="()"])
  case(Bound a x Q')
  have "x  P  R" and "x  Q  T" by fact+
  hence xFreshP: "x  P" and xFreshR: "x  R" and "x  Q" and "x  T" by simp+
  have QTTrans: "Q  T  a«x»  Q'" by fact
  thus ?case using x  Q x  T
  proof(induct rule: parCasesB)
    case(cPar1 Q')
    have QTrans: "Q  a«x»  Q'" and xFreshT: "x  T" by fact+
      
    from xFreshP PSimQ QTrans obtain P' where PTrans:"P  a«x»  P'"
                                          and Pderivative: "derivative P' Q' a x Rel"
      by(blast dest: simE)
    from PTrans xFreshR have "P  R  a«x»  P'  R" by(rule Late_Semantics.Par1B)
    moreover from Pderivative xFreshR xFreshT RRel'T have "derivative (P'  R) (Q'  T) a x Rel''"
      by(cases a, auto intro: Par simp add: derivative_def forget)
    ultimately show ?case by blast
  next
    case(cPar2 T')
    have TTrans: "T  a«x»  T'" and xFreshQ: "x  Q" by fact+
    
    from xFreshR RSimT TTrans obtain R' where RTrans:"R  a«x»  R'"
                                          and Rderivative: "derivative R' T' a x Rel'"
      by(blast dest: simE)
    from RTrans xFreshP have ParTrans: "P  R  a«x»  P  R'" by(rule Late_Semantics.Par2B)      
    moreover from Rderivative xFreshP xFreshQ PRelQ have "derivative (P  R') (Q   T') a x Rel''"
      by(cases a, auto intro: Par simp add: derivative_def forget)
    ultimately show ?case by blast
  qed
next
  case(Free α QT')
  have QTTrans: "Q  T  α  QT'" by fact
  thus ?case using PSimQ RSimT PRelQ RRel'T
  proof(induct rule: parCasesF[where C="(P, R)"])
    case(cPar1 Q')
    have RRel'T: "(R, T)  Rel'" by fact
    have "P ↝[Rel] Q" and "Q  α  Q'" by fact+
    then obtain P' where PTrans: "P  α  P'" and PRel: "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans have Trans: "P  R  α  P'  R" by(rule Late_Semantics.Par1F)
    moreover from PRel RRel'T have "(P'  R, Q'  T)  Rel''" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cPar2 T')
    have PRelQ: "(P, Q)  Rel" by fact
    have "R ↝[Rel'] T" and "T  α  T'" by fact+
    then obtain R' where RTrans: "R  α  R'" and RRel: "(R', T')  Rel'"
      by(blast dest: simE)
    from RTrans have Trans: "P  R  α  P  R'" by(rule Late_Semantics.Par2F)
    moreover from PRelQ RRel have "(P  R', Q  T')  Rel''" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cComm1 Q' T' a b x)
    from x  (P, R) have "x  P" by simp
    with P ↝[Rel] Q Q  a<x>  Q' x  P
    obtain P' where PTrans: "P a<x>  P'" 
                and Pderivative: "derivative P' Q' (InputS a) x Rel"
      by(blast dest: simE)
    from Pderivative have PRel: "(P'[x::=b], Q'[x::=b])  Rel" by(simp add: derivative_def)
      
    have "R ↝[Rel'] T" and "T  a[b]  T'" by fact+
    then obtain R' where RTrans: "R a[b]  R'" and RRel: "(R', T')  Rel'"
      by(blast dest: simE)
      
    from PTrans RTrans have "P  R  τ  P'[x::=b]  R'" by(rule Late_Semantics.Comm1)
    moreover from PRel RRel have "(P'[x::=b]  R', Q'[x::=b]  T')  Rel''" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cComm2 Q' T' a b x)
    have "P ↝[Rel] Q" and "Q a[b]  Q'" by fact+
    then obtain P' where PTrans: "P a[b]  P'" and PRel: "(P', Q')  Rel"
      by(blast dest: simE)
    
    from x  (P, R) have "x  R" by simp
    with R ↝[Rel'] T T a<x>  T'
    obtain R' where RTrans: "R a<x>  R'"
                and Rderivative: "derivative R' T' (InputS a) x Rel'"
      by(blast dest: simE)
    from Rderivative have RRel: "(R'[x::=b], T'[x::=b])  Rel'" by(simp add: derivative_def)
      
    from PTrans RTrans have "P  R  τ  P'  R'[x::=b]" by(rule Late_Semantics.Comm2)
    moreover from PRel RRel have "(P'  R'[x::=b], Q'  T'[x::=b])  Rel''" by(blast intro: Par)
    ultimately show "P'. P  R  τ  P'  (P', Q'  T'[x::=b])  Rel''" by blast
  next
    case(cClose1 Q' T' a x y)
    from x  (P, R) have "x  P" by simp
    with P ↝[Rel] Q Q a<x>  Q'
    obtain P' where PTrans: "P a<x>  P'"
                and Pderivative: "derivative P' Q' (InputS a) x Rel"
      by(blast dest: simE)
    from Pderivative have PRel: "(P'[x::=y], Q'[x::=y])  Rel" by(simp add: derivative_def)
      
    from y  (P, R) have "y  R" and "y  P" by simp+
    from R ↝[Rel'] T T ay>  T' y  R
    obtain R' where RTrans: "R ay>  R'"
                and Rderivative: "derivative R' T' (BoundOutputS a) y Rel'"
      by(blast dest: simE)
    from Rderivative have RRel: "(R', T')  Rel'" by(simp add: derivative_def)
    
    from PTrans RTrans y  P have Trans: "P  R  τ  y>(P'[x::=y]  R')"
      by(rule Late_Semantics.Close1)
    moreover from PRel RRel have "(y>(P'[x::=y]  R'), y>(Q'[x::=y]  T'))  Rel''"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  next
    case(cClose2 Q' T' a x y)
    from y  (P, R) have "y  P" and "y  R" by simp+
    from P ↝[Rel] Q Q ay>  Q' y  P
    obtain P' where PTrans: "P ay>  P'" and P'RelQ': "(P', Q')  Rel"
      by(force dest: simE simp add: derivative_def)
    
    from x  (P, R) have "x  R" by simp+
    with R ↝[Rel'] T T a<x>  T'
    obtain R' where RTrans: "R a<x>  R'"
                and R'Rel'T': "(R'[x::=y], T'[x::=y])  Rel'" 
      by(force dest: simE simp add: derivative_def)
      
    from PTrans RTrans y  R have Trans: "P  R  τ  y>(P'  R'[x::=y])"
      by(rule Close2)
    moreover from P'RelQ' R'Rel'T' have "(y>(P'  R'[x::=y]), y>(Q'  T'[x::=y]))  Rel''"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  qed
qed

lemma parPres:
  fixes P   :: pi
  and   Q   :: pi
  and   R   :: pi
  and   a   :: name
  and   b   :: name
  and   Rel :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"
  
  assumes PSimQ:    "P ↝[Rel] Q"
  and     PRelQ:    "(P, Q)  Rel"
  and     Par:      "P Q R. (P, Q)  Rel  (P  R, Q  R)  Rel'"
  and     Res:      "P Q a. (P, Q)  Rel'  (a>P, a>Q)  Rel'"
  and     EqvtRel:  "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "P  R ↝[Rel'] Q  R"
proof -
  note PSimQ 
  moreover have RSimR: "R ↝[Id] R" by(auto intro: reflexive)
  moreover note PRelQ moreover have "(R, R)  Id" by auto
  moreover from Par have "P Q R T. (P, Q)  Rel; (R, T)  Id  (P  R, Q  T)  Rel'"
    by auto
  moreover note Res ‹eqvt Rel
  moreover have "eqvt Id" by(auto simp add: eqvt_def)
  ultimately show ?thesis using EqvtRel' by(rule parCompose)
qed

lemma resDerivative:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: subject
  and   x    :: name
  and   y    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"
  
  assumes Der: "derivative P Q a x Rel"
  and     Rel: "(P::pi) (Q::pi) (x::name). (P, Q)  Rel  (x>P, x>Q)  Rel'"
  and     Eqv: "eqvt Rel"

  shows "derivative (y>P) (y>Q) a x Rel'"
proof -
  from Der Rel show ?thesis
  proof(cases a, auto simp add: derivative_def)
    fix u
    assume A1: "u. (P[x::=u], Q[x::=u])  Rel"
    show "((y>P)[x::=u], (y>Q)[x::=u])  Rel'" 
    proof(cases "x=y")
      assume xeqy: "x=y"

      from A1 have "(P[x::=x], Q[x::=x])  Rel" by blast
      hence L1: "(y>P, y>Q)  Rel'" by(force intro: Rel)

      have "y  y>P" and "y  y>Q" by(simp only: freshRes)+
      hence "(y>P)[y::=u] = y>P" and "(y>Q)[y::=u] = y>Q" by(simp add: forget)+

      with L1 xeqy show ?thesis by simp
    next
      assume xineqy: "xy"

      show ?thesis
      proof(cases "y=u")
        assume yequ: "y=u"
      
        have "(c::name). c  (P, Q, x, y)" by(blast intro: name_exists_fresh)
        then obtain c where cFreshP: "c  P" and cFreshQ: "c  Q" and cineqx: "c  x" and cineqy: "y  c"
          by(force simp add: fresh_prod name_fresh)
        
        from A1 have "(P[x::=c], Q[x::=c])  Rel" by blast
        with Eqv have "([(y, c)]  (P[x::=c]), [(y, c)]  (Q[x::=c]))  Rel" by(rule eqvtRelI)
        with xineqy cineqx cineqy have "(([(y, c)]  P)[x::=y], ([(y, c)]  Q)[x::=y])  Rel"
          by(simp add: eqvt_subs name_calc)
        hence "(c>(([(y, c)]  P)[x::=y]), c>(([(y, c)]  Q)[x::=y]))  Rel'" by(rule Rel)
        with cineqx cineqy have "((c>(([(y, c)]  P)))[x::=y], (c>(([(y, c)]  Q)))[x::=y]) Rel'" by simp
        moreover from cFreshP cFreshQ have "c>([(y, c)]  P) = y>P" and "c>([(y, c)]  Q) = y>Q"
          by(simp add: alphaRes)+
        ultimately show ?thesis using yequ by simp
      next
        assume yinequ: "y  u"
        from A1 have "(P[x::=u], Q[x::=u])  Rel" by blast
        hence "(y>(P[x::=u]), y>(Q[x::=u]))  Rel'" by(rule Rel)
        with xineqy yinequ show ?thesis by simp
      qed
    qed
  qed
qed

lemma resPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   x    :: name
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"
  and     ResRel: "(P::pi) (Q::pi) (x::name). (P, Q)  Rel  (x>P, x>Q)  Rel'"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel: "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "x>P ↝[Rel'] x>Q"
using EqvtRel'
proof(induct rule: resSimCases[of _ _ _ _ "(P, x)"])
  case(BoundOutput Q' a)
  have QTrans: "Q a[x]  Q'" and aineqx: "a  x" by fact+
  
  from PSimQ QTrans obtain P' where PTrans: "P  a[x]  P'"
                                and P'RelQ': "(P', Q')  Rel"
    by(blast dest: simE)
  
  from PTrans aineqx have "x>P ax>  P'" by(rule Late_Semantics.Open)
  moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by force
  ultimately show ?case by blast
next
  case(BoundR Q' a y)
  have QTrans: "Q a«y»  Q'" and xFresha: "x  a" by fact+
  have "y  (P, x)" by fact 
  hence yFreshP: "y  P" and yineqx: "y  x" by(simp add: fresh_prod)+
  
  from PSimQ yFreshP QTrans  obtain P' where PTrans: "P a«y»  P'"
                                         and Pderivative: "derivative P' Q' a y Rel"
    by(blast dest: simE)
  from PTrans xFresha yineqx have ResTrans: "x>P a«y»  x>P'"
    by(blast intro: Late_Semantics.ResB)
  moreover from Pderivative ResRel EqvtRel have "derivative (x>P') (x>Q') a y Rel'"
    by(rule resDerivative)
  
  ultimately show ?case by blast
next
  case(FreeR Q' α)
  have QTrans: "Q  α  Q'" and xFreshAlpha: "(x::name)  α" by fact+
      
  from QTrans PSimQ obtain P' where PTrans: "P  α  P'"
                                and P'RelQ': "(P', Q')  Rel"
    by(blast dest: simE)

  from PTrans xFreshAlpha have "x>P α  x>P'" by(rule Late_Semantics.ResF)
  moreover from P'RelQ' have "(x>P', x>Q')  Rel'" by(rule ResRel)
  ultimately show ?case by blast
qed

lemma resChainI:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   xs  :: "name list"

  assumes PRelQ:   "P ↝[Rel] Q"
  and     eqvtRel: "eqvt Rel"
  and     Res:     "P Q x. (P, Q)  Rel  (x>P, x>Q)  Rel"

  shows "(resChain xs) P ↝[Rel] (resChain xs) Q"
proof(induct xs) (* Base case *)
  from PRelQ show "resChain [] P ↝[Rel] resChain [] Q" by simp
next (* Inductive step *)
  fix x xs
  assume IH: "(resChain xs P) ↝[Rel] (resChain xs Q)"
  moreover note Res
  moreover have "Rel  Rel" by simp
  ultimately have "x>(resChain xs P) ↝[Rel] x>(resChain xs Q)" using eqvtRel
    by(rule_tac resPres) 
  
  thus "resChain (x # xs) P ↝[Rel] resChain (x # xs) Q"
    by simp
qed

lemma bangPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
 
  assumes PRelQ:    "(P, Q)  Rel"
  and     Sim:      "P Q. (P, Q)  Rel  P ↝[Rel] Q"
  and     eqvtRel:  "eqvt Rel"

  shows "!P ↝[bangRel Rel] !Q"
proof -
  let ?Sim = "λP Rs. (a x Q'. Rs = a«x»  Q'  x  P  (P'. P a«x»  P'  derivative P' Q' a x (bangRel Rel))) 
                     (α Q'. Rs = α  Q'  (P'. P α  P'  (P', Q')  bangRel Rel))"
  from eqvtRel have EqvtBangRel: "eqvt(bangRel Rel)" by(rule eqvtBangRel)

  {
    fix Pa Rs
    assume "!Q  Rs" and "(Pa, !Q)  bangRel Rel"
    hence "?Sim Pa Rs" using PRelQ
    proof(nominal_induct avoiding: Pa P rule: bangInduct)
      case(cPar1B a x Q' Pa P)
      have QTrans: "Q  a«x»  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" and "x  Pa" by fact+
      thus "?Sim Pa (a«x»  (Q'  !Q))"
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" by fact
        have PBRQ: "(R, !Q)  bangRel Rel" by fact
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        show ?case 
        proof(auto simp add: residual.inject alpha')
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)

          with QTrans xFreshP obtain P' where PTrans: "P  a«x»  P'" and P'RelQ': "derivative P' Q' a x Rel"
            by(blast dest: simE)

          from PTrans xFreshR have "P  R  a«x»  (P'  R)"
            by(force intro: Late_Semantics.Par1B)
          moreover from P'RelQ' PBRQ x  Q x  R have "derivative (P'  R) (Q'  !Q) a x (bangRel Rel)"
            by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
          ultimately show "P'. P  R a«x»  P'  derivative P' (Q'  !Q) a x (bangRel Rel)" by blast
        next
          fix y
          assume "(y::name)  Q'" and "y  P" and "y  R" and "y  Q"
          from QTrans y  Q' have "Q a«y»  ([(x, y)]  Q')"
            by(simp add: alphaBoundResidual)
          moreover from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          ultimately obtain P' where PTrans: "P a«y»  P'" and P'RelQ': "derivative P' ([(x, y)]  Q') a y Rel"
            using y  P
            by(blast dest: simE)
          from PTrans y  R have "P  R a«y»  (P'  R)" by(force intro: Late_Semantics.Par1B)
          moreover from P'RelQ' PBRQ y  Q y  R have "derivative (P'  R) (([(x, y)]  Q')  !Q) a y (bangRel Rel)"
            by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
          with x  Q y  Q have "derivative (P'  R) (([(y, x)]  Q')  !([(y, x)]  Q)) a y (bangRel Rel)"
            by(simp add: name_fresh_fresh name_swap)
          ultimately show "P'. P  R a«y»  P'  derivative P' (([(y, x)]  Q')  !([(y, x)]  Q)) a y (bangRel Rel)"
            by blast
        qed
      qed
    next
      case(cPar1F α Q' Pa P)
      have QTrans: "Q α  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and BR: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P  α  P'" and RRel: "(P', Q')  Rel"
            by(blast dest: simE)
          
          from PTrans have "P  R  α  P'  R" by(rule Par1F)
          moreover from RRel BR have "(P'  R, Q'  !Q)  bangRel Rel" by(rule Rel.BRPar)
          ultimately show "P'. P  R  α  P'  (P', Q'  !Q)  bangRel Rel" by blast
        qed
      qed
    next
      case(cPar2B a x Q' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (a«x»  Q')" by simp
      have "(Pa, Q  !Q)  bangRel Rel" and "x  Pa" by fact+
      thus "?Sim Pa (a«x»  (Q  Q'))"
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+

        from EqvtBangRel x  Q show "?Sim (P  R) (a«x»  (Q  Q'))"
        proof(auto simp add: residual.inject alpha' name_fresh_fresh)
          from RBRQ have "?Sim R (a«x»  Q')" by(rule IH)
          with xFreshR obtain R' where RTrans: "R  a«x»  R'" and R'BRQ': "derivative R' Q' a x (bangRel Rel)"
            by(auto simp add: residual.inject)
          from RTrans xFreshP have "P  R  a«x»  (P  R')" by(auto intro: Par2B)
          moreover from PRelQ R'BRQ' x  Q x  P have "derivative (P  R') (Q  Q') a x (bangRel Rel)" 
            by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
          ultimately show "P'. P  R  a«x»  P'  derivative P' (Q  Q') a x (bangRel Rel)" by blast
        next
          fix y
          assume "(y::name)  Q" and "y  Q'" and "y  P" and "y  R"
          from RBRQ have "?Sim R (a«x»  Q')" by(rule IH)
          with y  Q' have "?Sim R (a«y»  ([(x, y)]  Q'))" by(simp add: alphaBoundResidual)
          with y  R obtain R' where RTrans: "R  a«y»  R'" and R'BRQ': "derivative R' ([(x, y)]  Q') a y (bangRel Rel)"
            by(auto simp add: residual.inject)
          from RTrans y  P have "P  R  a«y»  (P  R')" by(auto intro: Par2B)
          moreover from PRelQ R'BRQ' y  P y  Q have "derivative (P  R') (Q  ([(x, y)]  Q')) a y (bangRel Rel)" 
            by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
          hence "derivative (P  R') (Q  ([(y, x)]  Q')) a y (bangRel Rel)"
            by(simp add: name_swap)
          ultimately show "P'. P  R  a«y»  P'  derivative P' (Q  ([(y, x)]  Q')) a y (bangRel Rel)" by blast
        qed
      qed
    next
      case(cPar2F α Q' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (α  Q')" by simp
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from RBRQ IH have "R'. R  α  R'  (R', Q')  bangRel Rel"
            by(metis simE)
          then obtain R' where RTrans: "R  α  R'" and R'RelQ': "(R', Q')  bangRel Rel"
            by blast

          from RTrans have "P  R  α  P  R'" by(rule Par2F)
          moreover from PRelQ R'RelQ' have "(P  R', Q  Q')  bangRel Rel" by(rule Rel.BRPar)
          ultimately show " P'. P  R  α  P'  (P', Q  Q')  bangRel Rel" by blast
        qed
      qed
    next
      case(cComm1 a x Q' b Q'' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (a[b]  Q'')" by simp
      have QTrans: "Q a<x>  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case using x  Pa
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        from x  P  R have "x  P" and "x  R" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          with QTrans x  P obtain P' where PTrans: "P  a<x>  P'" and P'RelQ': "(P'[x::=b], Q'[x::=b])  Rel"
            by(drule_tac simE) (auto simp add: derivative_def)
          
          from IH RBRQ have RTrans: "R'. R  a[b]  R'  (R', Q'')  bangRel Rel"
            by(auto simp add: derivative_def)
          then obtain R' where RTrans: "R  a[b]  R'" and R'RelQ'': "(R', Q'')  bangRel Rel"
            by blast
          
          from PTrans RTrans have "P  R τ  P'[x::=b]  R'" by(rule Comm1)
          moreover from P'RelQ' R'RelQ'' have "(P'[x::=b]  R', Q'[x::=b]  Q'')  bangRel Rel" by(rule Rel.BRPar)
          ultimately show "P'. P  R  τ  P'  (P', Q'[x::=b]  Q'')  bangRel Rel" by blast
        qed
      qed
    next
      case(cComm2 a b Q' x Q'' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (a<x>  Q'')" by simp
      have QTrans: "Q  a[b]  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case using x  Pa
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        from x  P  R have "x  P" and "x  R" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P  a[b]  P'" and P'RelQ': "(P', Q')  Rel"
            by(blast dest: simE)

          from IH RBRQ x  R have RTrans: "R'. R  a<x>  R'  (R'[x::=b], Q''[x::=b])  bangRel Rel"
            by(fastforce simp add: derivative_def residual.inject)
          then obtain R' where RTrans: "R  a<x>  R'" and R'RelQ'': "(R'[x::=b], Q''[x::=b])  bangRel Rel"
            by blast

          from PTrans RTrans have "P  R  τ  P'  R'[x::=b]" by(rule Comm2)
          moreover from P'RelQ' R'RelQ'' have "(P'  R'[x::=b], Q'  Q''[x::=b])  bangRel Rel" by(rule Rel.BRPar)
          ultimately show "P'. P  R  τ  P'  (P', Q'  (Q''[x::=b]))  bangRel Rel" by blast
        qed
      qed
    next
      case(cClose1 a x Q' y Q'' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (ay>  Q'')" by simp
      have QTrans: "Q  a<x>  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      moreover have xFreshPa: "x  Pa" by fact
      ultimately show ?case using y  Pa
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" and "y  P  R" by fact+
        hence xFreshP: "x  P" and xFreshR: "x  R" and "y  R" and "y  P" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          with QTrans xFreshP obtain P' where PTrans: "P a<x>  P'" and P'RelQ': "(P'[x::=y], Q'[x::=y])  Rel"
            by(fastforce dest: simE simp add: derivative_def)

           from RBRQ y  R IH have "R'. R ay>  R'  (R', Q'')  bangRel Rel"
             by(auto simp add: residual.inject derivative_def)
           then obtain R' where RTrans: "R ay>  R'" and R'RelQ'': "(R', Q'')  bangRel Rel"
             by blast

           from PTrans RTrans y  P have "P  R τ  y>(P'[x::=y]  R')"
             by(rule Close1)     
           moreover from P'RelQ' R'RelQ'' have "(y>(P'[x::=y]  R'), y>(Q'[x::=y]  Q''))  bangRel Rel"
             by(force intro: Rel.BRPar BRRes)
           ultimately show "P'. P  R  τ  P'  (P', y>(Q'[x::=y]  Q''))  bangRel Rel" by blast
         qed
      qed
    next
      case(cClose2 a x Q' y Q'' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (a<y>  Q'')" by simp
      have QTrans: "Q  ax>  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" and "x  Pa" and "y  Pa" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" and "y  P  R" by fact+
        hence xFreshP: "x  P" and xFreshR: "x  R" and "y  R" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          with QTrans xFreshP obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel"
            by(fastforce dest: simE simp add: derivative_def)

          from RBRQ IH y  R have "R'.  R a<y>  R'  (R'[y::=x], Q''[y::=x])  bangRel Rel"
            by(fastforce simp add: derivative_def residual.inject)
          then obtain R' where RTrans: "R a<y>  R'" and R'RelQ'': "(R'[y::=x], Q''[y::=x])  bangRel Rel"
            by blast

          from PTrans RTrans xFreshR have "P  R  τ  x>(P'  R'[y::=x])"
            by(rule Close2)
          moreover from P'RelQ' R'RelQ'' have "(x>(P'  R'[y::=x]), x>(Q'  Q''[y::=x]))  bangRel Rel"
            by(force intro: Rel.BRPar BRRes)
          ultimately show "P'. P  R  τ  P'  (P', x>(Q'  Q''[y::=x]))  bangRel Rel" by blast
        qed
      qed
    next
      case(cBang Rs Pa P)
      hence IH: "Pa. (Pa, Q  !Q)  bangRel Rel  ?Sim Pa Rs" by simp
      have "(Pa, !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRBangCases)
        case(BRBang P)
        have PRelQ: "(P, Q)  Rel" by fact
        hence "(!P, !Q)  bangRel Rel" by(rule Rel.BRBang)
        with PRelQ have "(P  !P, Q  !Q)  bangRel Rel" by(rule BRPar)
        with IH have "?Sim (P  !P) Rs" by simp
        thus ?case by(force intro: Bang)
      qed
    qed
  }

  moreover from PRelQ have "(!P, !Q)  bangRel Rel" by(rule BRBang) 
  ultimately show ?thesis by(auto simp add: simulation_def)
qed

end

Theory Strong_Late_Bisim_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Bisim_Pres
  imports Strong_Late_Bisim Strong_Late_Sim_Pres
begin

lemma tauPres:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"

  shows "τ.(P)  τ.(Q)"
proof -
  let ?X = "{(τ.(P), τ.(Q)), (τ.(Q), τ.(P))}"
  have "(τ.(P), τ.(Q))  ?X" by auto
  thus ?thesis using P  Q
    by(coinduct rule: bisimCoinduct)
      (auto intro: Strong_Late_Sim_Pres.tauPres dest: symmetric)
qed

lemma inputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   x :: name

  assumes PSimQ: "y. P[x::=y]  Q[x::=y]"
  
  shows "a<x>.P  a<x>.Q"
proof -
  let ?X = "{(a<x>.P, a<x>.Q) | a x P Q. y. P[x::=y]  Q[x::=y]}"
  {
    fix axP axQ p
    assume "(axP, axQ)  ?X"
    then obtain a x P Q where A: "y. P[x::=y]  Q[x::=y]" and B: "axP = a<x>.P" and C: "axQ = a<x>.Q"
      by auto
    have "y. ((p::name prm)  P)[(p  x)::=y]  (p  Q)[(p  x)::=y]"
    proof -
      fix y
      from A have "P[x::=(rev p  y)]  Q[x::=(rev p  y)]"
        by blast
      hence "(p  (P[x::=(rev p  y)]))  p  (Q[x::=(rev p  y)])"
        by(rule bisimClosed)
      thus "(p  P)[(p  x)::=y]  (p  Q)[(p  x)::=y]"
        by(simp add: eqvts pt_pi_rev[OF pt_name_inst, OF at_name_inst])
    qed
    hence "((p::name prm)  axP, p  axQ)  ?X" using B C
      by auto
  }
  hence "eqvt ?X" by(simp add: eqvt_def)

  from PSimQ have "(a<x>.P, a<x>.Q)  ?X" by auto
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim P Q)
    thus ?case using ‹eqvt ?X
      by(force intro: inputPres)
  next
    case(cSym P Q)
    thus ?case
      by(blast dest: symmetric)
  qed
qed

lemma outputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "a{b}.P  a{b}.Q"
proof -
  let ?X = "{(a{b}.P, a{b}.Q), (a{b}.Q, a{b}.P)}"
  have "(a{b}.P, a{b}.Q)  ?X" by auto
  thus ?thesis using P  Q
    by(coinduct rule: bisimCoinduct)
      (auto intro: Strong_Late_Sim_Pres.outputPres dest: symmetric)
qed

lemma matchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
proof -
  let ?X = "{([ab]P, [ab]Q), ([ab]Q, [ab]P)}"
  have "([ab]P, [ab]Q)  ?X" by auto
  thus ?thesis using P  Q
    by(coinduct rule: bisimCoinduct)
      (auto intro: Strong_Late_Sim_Pres.matchPres dest: symmetric bisimE)
qed

lemma mismatchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
proof -
  let ?X = "{([ab]P, [ab]Q), ([ab]Q, [ab]P)}"
  have "([ab]P, [ab]Q)  ?X" by auto
  thus ?thesis using P  Q
    by(coinduct rule: bisimCoinduct)
      (auto intro: Strong_Late_Sim_Pres.mismatchPres dest: symmetric bisimE)
qed

lemma sumPres: 
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P  Q"

  shows "P  R  Q  R"
proof -
  let ?X = "{(P  R, Q  R), (Q  R, P  R)}"
  have "(P  R, Q  R)  ?X" by auto
  thus ?thesis using P  Q
    by(coinduct rule: bisimCoinduct)
      (auto intro: Strong_Late_Sim_Pres.sumPres reflexive dest: symmetric bisimE)
qed

lemma resPres:
  fixes P :: pi
  and   Q :: pi
  and   x :: name
  
  assumes "P  Q"

  shows "x>P  x>Q"
proof -
  let ?X = "{x. P Q. P  Q  (a. x = (a>P, a>Q))}"
  from P  Q have "(x>P, x>Q)  ?X" by blast
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim xP xQ)
    {
      fix P Q a
      assume PSimQ: "P ↝[bisim] Q"
      moreover have "P Q a. P  Q  (a>P, a>Q)  ?X  bisim" by blast
      moreover have "bisim  ?X  bisim" by blast
      moreover have "eqvt bisim" by simp
      moreover have "eqvt ?X"
        by(auto simp add: eqvt_def) (blast intro: bisimClosed)
      hence "eqvt (?X  bisim)" by auto
      ultimately have "a>P ↝[(?X  bisim)] a>Q"
        by(rule Strong_Late_Sim_Pres.resPres)
    }
    with (xP, xQ)  ?X show ?case
      by(auto dest: bisimE)
  next
    case(cSym xP xQ)
    thus ?case by(auto dest: symmetric)
  qed
qed

lemma parPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P  Q"

  shows "P  R  Q  R"
proof -
  let ?X = "{(resChain lst (P  R), resChain lst (Q  R)) | lst P R Q. P  Q}"
  have EmptyChain: "P Q. P  Q = resChain [] (P  Q)" by auto
  with P  Q have "(P  R, Q  R)  ?X" by blast
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim PR QR)
    {
      fix P Q R lst

      assume "P  Q"

      hence "P ↝[bisim] Q" by(rule bisimE)
      moreover note P  Q
      moreover have "P Q R. P  Q  (P  R, Q  R)  ?X"
        by auto (blast intro: EmptyChain)
      moreover 
      {
        fix xP xQ x
        assume "(xP, xQ)  ?X"
        then obtain P Q R lst 
          where "P  Q" and "xP = resChain lst (P  R)" and xQeq: "xQ = resChain lst (Q  R)"
          by auto
        moreover hence "(resChain (x#lst) (P  R), resChain (x#lst) (Q  R))  ?X"
          by blast
        ultimately have "(x>xP, x>xQ)  ?X" by auto
      }
      note ResPres = this
      moreover have "eqvt bisim" by simp
      moreover have "eqvt ?X"
        by(auto simp add: eqvt_def) (blast intro: bisimClosed)
      ultimately have "P  R ↝[(?X)] Q  R" by(rule parPres)
      hence "resChain lst (P  R) ↝[?X] (resChain lst (Q  R))" using ‹eqvt ?X ResPres 
        by(rule resChainI)
      hence "resChain lst (P  R) ↝[(?X  bisim)] (resChain lst (Q  R))"
        by(force intro: Strong_Late_Sim.monotonic)
    }
    with (PR, QR)  ?X show ?case
      by auto
  next
    case(cSym PR QR)
    thus ?case by(blast dest: symmetric)
  qed
qed


lemma bangPres:
  fixes P :: pi
  and   Q :: pi

  assumes PBiSimQ: "P  Q"

  shows "!P  !Q"
proof -
  let ?X = "bangRel bisim"
  from PBiSimQ have "(!P, !Q)  ?X" by(rule Rel.BRBang)
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim bP bQ)
    {
      fix P Q
      assume "(P, Q)  ?X"
      hence "P ↝[?X] Q"
      proof(induct)
        fix P Q
        assume "P  Q"
        thus "!P ↝[?X] !Q" using bisimE bisimEqvt
          by(rule Strong_Late_Sim_Pres.bangPres)
      next
        fix P Q R T
        assume RBiSimT: "R  T"
        assume PBangRelQ: "(P, Q)  ?X"
        assume PSimQ: "P ↝[?X] Q"
        from RBiSimT  have "R ↝[bisim] T" by(blast dest: bisimE)
        thus "R  P ↝[?X] T  Q" using PSimQ RBiSimT PBangRelQ Rel.BRPar Rel.BRRes bisimEqvt eqvtBangRel
          by(blast intro: Strong_Late_Sim_Pres.parCompose)
      next
        fix P Q a
        assume "P ↝[?X] Q"
        moreover from eqvtBangRel bisimEqvt have "eqvt ?X" by blast 
        ultimately show "a>P ↝[?X] a>Q" using Rel.BRRes by(blast intro: Strong_Late_Sim_Pres.resPres)
      qed
      hence "P ↝[((bangRel bisim)  bisim)] Q" by(rule_tac Strong_Late_Sim.monotonic) auto
    }
    with (bP, bQ)  ?X show ?case by auto
  next
    case(cSym bP bQ)
    thus ?case by(metis bangRelSymetric symmetric)
  qed
qed

end

Theory Strong_Late_Bisim_Subst_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Bisim_Subst_Pres
  imports Strong_Late_Bisim_Subst Strong_Late_Bisim_Pres
begin

lemma tauPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "τ.(P) s τ.(Q)"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.tauPres)

lemma inputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   x :: name

  assumes "P s Q"

  shows "a<x>.P s a<x>.Q"
proof(auto simp add: substClosed_def)
  fix σ :: "(name × name) list"
  {
    fix P Q a x σ
    assume "P s Q"
    then have "P[<σ>] s Q[<σ>]" by(rule partUnfold)
    then have "y. (P[<σ>])[x::=y]  (Q[<σ>])[x::=y]"
      apply(auto simp add: substClosed_def)
      by(erule_tac x="[(x, y)]" in allE) auto
    moreover assume "x  σ"
    ultimately have "(a<x>.P)[<σ>]  (a<x>.Q)[<σ>]" using bisimEqvt
      by(force intro: Strong_Late_Bisim_Pres.inputPres)
  }
  note Goal = this

  obtain y::name where "y  P" and "y  Q" and "y  σ"
    by(generate_fresh "name") auto
  from P s Q have "([(x, y)]  P) s ([(x, y)]  Q)" by(rule eqClosed)
  hence "(a<y>.([(x, y)]  P))[<σ>]  (a<y>.([(x, y)]  Q))[<σ>]" using y  σ by(rule Goal)
  moreover from y  P y  Q have "a<x>.P = a<y>.([(x, y)]  P)" and "a<x>.Q = a<y>.([(x, y)]  Q)"
    by(simp add: alphaInput)+

  ultimately show "(a<x>.P)[<σ>]  (a<x>.Q)[<σ>]" by simp
qed

lemma outputPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "a{b}.P s a{b}.Q"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.outputPres)

lemma matchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P s Q"

  shows "[ab]P s [ab]Q"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.matchPres)

lemma mismatchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P s Q"

  shows "[ab]P s [ab]Q"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.mismatchPres)

lemma sumPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P s Q"

  shows "P  R s Q  R"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.sumPres)

lemma parPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P s Q"

  shows "P  R s Q  R"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.parPres)

lemma resPres:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes PeqQ: "P s Q"
  
  shows "x>P s x>Q"
proof(auto simp add: substClosed_def)
  fix s::"(name × name) list"

  have Res: "P Q x s. P[<s>]  Q[<s>]; x  s  (x>P)[<s>]  (x>Q)[<s>]"
    by(force intro: Strong_Late_Bisim_Pres.resPres)

  have "c::name. c  (P, Q, s)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshQ: "c  Q" and cFreshs: "c  s"
    by(force simp add: fresh_prod)

  from PeqQ have "P[<([(x, c)]  s)>]  Q[<([(x, c)]  s)>]" by(simp add: substClosed_def)
  hence "([(x, c)]  P[<([(x, c)]  s)>])  ([(x, c)]  Q[<([(x, c)]  s)>])" by(rule bisimClosed)
  hence "([(x, c)]  P)[<s>]  ([(x, c)]  Q)[<s>]" by simp
  hence "(c>([(x, c)]  P))[<s>]  (c>([(x, c)]  Q))[<s>]" using cFreshs by(rule Res)

  moreover from cFreshP cFreshQ have "x>P = c>([(x, c)]  P)" and "x>Q = c>([(x, c)]  Q)"
    by(simp add: alphaRes)+

  ultimately show "(x>P)[<s>]  (x>Q)[<s>]" by simp
qed

lemma bangPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "!P s !Q"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.bangPres)

end

Theory Late_Tau_Chain

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Late_Tau_Chain
  imports Late_Semantics1
begin

abbreviation "tauChain_judge" :: "pi  pi  bool" ("_ τ _" [80, 80] 80)
where "P τ P'  (P, P')  {(P, P') | P P'. P τ  P'}^*"

lemma singleTauChain:
  fixes P  :: pi
  and   P' :: pi

  assumes "P τ  P'"

  shows "P τ P'"
using assms by(simp add: r_into_rtrancl)

lemma tauChainAddTau[dest]:
  fixes P   :: pi
  and   P'  :: pi
  and   P'' :: pi

  shows "P τ P'  P' τ  P''  P τ P''" 
  and "P τ  P'  P' τ P''  P τ P''"
by(auto dest: singleTauChain)

lemma tauChainInduct[consumes 1, case_names id ih]:
  fixes P  :: pi
  and   P' :: pi

  assumes "P τ P'"
  and     "F P"
  and     "P' P''. P τ P'; P' τ  P''; F P'  F P''"

  shows "F P'"
using assms  
by(drule_tac rtrancl_induct) auto

lemma eqvtChainI[eqvt]:
  fixes P    :: pi
  and   P'   :: pi
  and   perm :: "name prm"

  assumes "P τ P'"

  shows "(perm  P) τ (perm  P')"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P'' P''')
  have "P τ P''" and "P''  τ  P'''" by fact+
  hence "(perm  P'') τ  (perm  P''')" by(force dest: transitions.eqvt)
  moreover have "(perm  P) τ (perm  P'')" by fact
  ultimately show ?case by auto
qed


lemma eqvtChainE:
  fixes perm :: "name prm"
  and   P    :: pi
  and   P'   :: pi

  assumes Trans: "(perm  P) τ (perm  P')"

  shows   "P τ P'"
proof -
  have "rev perm  (perm  P) = P" by(simp add: pt_rev_pi[OF pt_name_inst, OF at_name_inst])
  moreover have "rev perm  (perm  P') = P'" by(simp add: pt_rev_pi[OF pt_name_inst, OF at_name_inst])
  ultimately show ?thesis using assms
    by(drule_tac perm="rev perm" in eqvtChainI, simp)
qed

lemma eqvtChainEq:
  fixes P    :: pi
  and   P'   :: pi
  and   perm :: "name prm"

  shows   "P τ P' = (perm  P) τ (perm  P')"
by(blast intro: eqvtChainE eqvtChainI)

lemma freshChain:
  fixes P  :: pi
  and   P' :: pi
  and   x  :: name
  
  assumes "P τ P'"
  and     "x  P"
 
  shows   "x  P'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P' P'')
  have "x  P" and "x  P  x  P'" by fact+
  hence "x  P'" by simp
  moreover have "P'  τ  P''" by fact
  ultimately show ?case by(force intro: freshFreeDerivative)
qed

lemma matchChain:
  fixes b :: name
  and   P :: pi
  and   P' :: pi
  
  assumes "P τ P'"
  and     "P  P'"
 
  shows "[bb]P τ P'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P'' P''')
  have P''TransP''':  "P'' τ  P'''"  by fact
  show "[bb]P τ P'''" 
  proof(cases "P = P''")
    assume "P=P''"
    moreover with P''TransP''' have "[bb]P τ  P'''" by(force intro: Match)
    thus "[bb]P τ P'''" by(rule singleTauChain)
  next
    assume "P  P''"
    moreover have "P  P''  [bb]P τ P''" by fact
    ultimately show "[bb]P τ P'''" using P''TransP''' by(blast)
  qed
qed

lemma mismatchChain:
  fixes a :: name
  and   b :: name
  and   P :: pi
  and   P' :: pi
  
  assumes PChain: "P τ P'"
  and     aineqb: "a  b"
  and     PineqP': "P  P'"
 
  shows "[ab]P τ P'"
using PChain PineqP'
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P'' P''')
  have P''TransP''':  "P'' τ  P'''"  by fact
  show "[ab]P τ P'''" 
  proof(cases "P = P''")
    assume "P=P''"
    moreover with aineqb P''TransP''' have "[ab]P τ  P'''" by(force intro: Mismatch)
    thus "[ab]P τ P'''" by(rule singleTauChain)
  next
    assume "P  P''"
    moreover have "P  P''  [ab]P τ P''" by fact+
    ultimately show "[ab]P τ P'''" using P''TransP''' by(blast)
  qed
qed

lemma sum1Chain[rule_format]:
  fixes P  :: pi
  and   P' :: pi
  and   Q  :: pi

  assumes "P τ P'"
  and     "P  P'"
 
  shows "P  Q τ P'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P'' P''')
  have P''TransP''':  "P'' τ  P'''" by fact
  show "P  Q τ P'''"
  proof(cases "P = P''")
    assume "P=P''"
    moreover with P''TransP''' have "P  Q τ  P'''" by(force intro: Sum1)
    thus "P  Q τ P'''" by(force intro: singleTauChain)
  next
    assume "P  P''"
    moreover have "P  P''  P  Q τ P''" by fact
    ultimately show "P  Q τ P'''" using P''TransP''' by(force)
  qed
qed


lemma sum2Chain[rule_format]:
  fixes P  :: pi
  and   Q :: pi
  and   Q'  :: pi

  assumes "Q τ Q'"
  and     "Q  Q'"
 
  shows "P  Q τ Q'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih Q'' Q''')
  have Q''TransQ''':  "Q'' τ  Q'''" by fact
  show "P  Q τ Q'''"
  proof(cases "Q = Q''")
    assume "Q=Q''"
    moreover with Q''TransQ''' have "P  Q τ  Q'''" by(force intro: Sum2)
    thus "P  Q τ Q'''" by(force intro: singleTauChain)
  next
    assume "Q  Q''"
    moreover have "Q  Q''  P  Q τ Q''" by fact
    ultimately show "P  Q τ Q'''" using Q''TransQ''' by blast
  qed
qed

lemma Par1Chain:
  fixes P  :: pi
  and   P' :: pi
  and   Q  :: pi

  assumes "P τ P'"

  shows "P  Q τ P'  Q"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P'' P')
  have P''TransP':  "P'' τ  P'" by fact
  have IH: "P  Q τ P''  Q" by fact
  
  have "P''  Q τ  P'  Q" using P''TransP' by(force intro: Par1F)
  thus "P  Q τ P'  Q" using IH by(force)
qed

lemma Par2Chain:
  fixes P  :: pi
  and   Q  :: pi
  and   Q' :: pi

  assumes "Q τ Q'"

  shows "P  Q τ P  Q'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih Q'' Q')
  have Q''TransQ':  "Q'' τ  Q'" by fact
  have IH: "P  Q τ P  Q''" by fact
  
  have "P  Q'' τ  P  Q'" using Q''TransQ' by(force intro: Par2F)
  thus "P  Q τ P  Q'" using IH by(force)
qed

lemma chainPar:
  fixes P  :: pi
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi
  
  assumes "P τ P'"
  and     "Q τ Q'"

  shows "P  Q τ P'  Q'"
proof -
  from P τ P' have "P  Q τ P'  Q" by(rule Par1Chain)
  moreover from Q τ Q' have "P'  Q τ P'  Q'" by(rule Par2Chain)
  ultimately show ?thesis by auto
qed

lemma ResChain:
  fixes P  :: pi
  and   P' :: pi
  and   a  :: name

  assumes "P τ P'"

  shows "a>P τ a>P'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P'' P''')
  have "P'' τ  P'''" by fact
  hence "a>P'' τ  a>P'''" by(force intro: ResF)
  moreover have "a>P τ a>P''" by fact
  ultimately show ?case by force
qed

lemma substChain:
  fixes P  :: pi
  and   x  :: name
  and   b  :: name
  and   P' :: pi

  assumes PTrans: "P[x::=b] τ P'"

  shows "P[x::=b] τ P'[x::=b]"
proof(cases "x=b")
  assume "x = b"
  with PTrans show ?thesis by simp
next
  assume "x  b"
  hence "x  P[x::=b]" by(simp add: fresh_fact2)
  with PTrans have "x  P'" by(force intro: freshChain)
  hence "P' = P'[x::=b]" by(simp add: forget)
  with PTrans show ?thesis by simp
qed

lemma bangChain:
  fixes P  :: pi
  and   P' :: pi

  assumes PTrans: "P  !P τ P'"
  and     P'ineq: "P'  P  !P"

  shows "!P τ P'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P' P'')
  show ?case
  proof(cases "P' = P  !P")
    case True
    from P' τ  P'' P' = P  !P have "!P τ  P''" by(blast intro: Bang)
    thus ?thesis by auto
  next
    case False
    from P'  P  !P have "!P τ P'" by(rule ih)
    with P' τ  P'' show ?thesis by auto
  qed
qed

end

Theory Weak_Late_Step_Semantics

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Step_Semantics
  imports Late_Tau_Chain
begin

definition inputTransition :: "pi  name  pi  name  name  pi  bool" ("_ l_ in __<_>  _" [80, 80, 80, 80, 80] 80)
where "P lu in P'' a<x>  P'  P'''. P τ P'''  P''' a<x>  P''  P''[x::=u] τ P'"

definition transition :: "(pi × Late_Semantics.residual) set" where
  "transition  {x. P P' α P'' P'''. P τ P'  P' α  P''  P'' τ P'''  x = (P, α  P''')}  
                {x. P P' a y P'' P'''. P τ P'  (P' (ay>  P''))  P'' τ P'''  x = (P, (ay>  P'''))}"

abbreviation weakTransition_judge :: "pi  Late_Semantics.residual  bool" ("_ l _" [80, 80] 80)
  where "P l Rs  (P, Rs)  transition"

lemma weakNonInput[dest]:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi

  assumes "P la<x>  P'"
 
  shows False
using assms
by(auto simp add: transition_def residual.inject)

lemma transitionI:
  fixes P    :: pi
  and   P''' :: pi
  and   α    :: freeRes
  and   P''  :: pi
  and   P'   :: pi
  and   a    :: name
  and   x    :: name
  and   u    :: name

  shows "P τ P'''; P''' α  P''; P'' τ P'  P lα  P'"
  and   "P τ P'''; P''' ax>  P''; P'' τ P'  P lax>  P'"
  and   "P τ P'''; P''' a<x>  P''; P''[x::=u] τ P'  P lu in P''a<x>  P'"
proof -
  assume "P τ P'''" and "P'''  α  P''" and "P'' τ P'"
  thus "P l α  P'"
    by(force simp add: transition_def)
next
  assume "P τ P'''" and "P''' ax>  P''" and "P'' τ P'"
  thus "P lax>  P'"
    by(force simp add: transition_def)
next
  assume "P τ P'''" and "P''' a<x>  P''" and "P''[x::=u] τ P'"
  thus "P lu in P''a<x>  P'" 
    by(force simp add: inputTransition_def)
qed

lemma transitionE:
  fixes P  :: pi
  and   α  :: freeRes
  and   P'  :: pi
  and   P'' :: pi
  and   a   :: name
  and   u   :: name
  and   x   :: name

  shows "P lα  P'  P'' P'''. P τ P''  P'' α  P'''  P''' τ P'" (is "_  ?thesis1")
  and   "P lax>  P'; x  P  P'' P'''. P τ P'''  P''' ax>  P''  P'' τ P'"
  and   "P lu in P''a<x>  P'  P'''. P τ P'''  P''' a<x>  P''  P''[x::=u] τ P'"
proof -
  assume "P lα  P'"
  thus ?thesis1 by(auto simp add: transition_def residual.inject)
next
  assume "P lax>  P'" and "x  P"
  thus "P'' P'''. P τ P'''  P''' ax>  P''  P'' τ P'"
  using [[hypsubst_thin = true]]
    apply(auto simp add: transition_def residualInject name_abs_eq)
    apply(rule_tac x="[(x, y)]  P''" in exI)
    apply(rule_tac x=P' in exI)
    apply(clarsimp)
    apply(auto)
    apply(subgoal_tac "x  P''")
    apply(simp add: alphaBoundResidual name_swap)
    using freshChain
    apply(force dest: freshBoundDerivative)
    using eqvtChainI
    by simp
next
  assume PTrans: "P lu in P''a<x>  P'"
  thus "P'''. P τ P'''  P'''  a<x>  P''  P''[x::=u] τ P'"
    by(auto simp add: inputTransition_def)
qed

lemma alphaInput:
  fixes P   :: pi
  and   u   :: name
  and   P'' :: pi
  and   a   :: name
  and   x   :: name
  and   P'  :: pi
  and   y   :: name

  assumes PTrans:  "P lu in P''a<x>  P'"
  and     yFreshP: "y  P"

  shows "P lu in ([(x, y)]  P'')a<y>  P'"
proof(cases "x=y")
  assume "x=y"
  with PTrans show ?thesis by simp
next
  assume xineqy: "xy"
  from PTrans obtain P''' where PChain: "P τ P'''"
                            and P'''Trans: "P''' a<x>  P''"
                            and P''Chain: "P''[x::=u] τ P'"
    by(blast dest: transitionE)

  from PChain yFreshP have "y  P'''" by(rule freshChain)
  with P'''Trans xineqy have yFreshP'': "y  P''" by(blast dest: freshBoundDerivative)

  with P'''Trans have "P''' a<y>  [(x, y)]  P''" by(simp add: alphaBoundResidual)
  moreover from P''Chain yFreshP'' have "([(x, y)]  P'')[y::=u] τ P'"
    by(simp add: renaming name_swap)
  ultimately show ?thesis using PChain by(blast intro: transitionI)
qed

lemma tauActionChain:
  fixes P  :: pi
  and   P' :: pi
  
  shows "P lτ  P'  P τ P'"
  and   "P  P'  P τ P'  P lτ  P'"
proof -
  assume "P lτ  P'"
  then obtain P'' P''' where "P τ P''"
                         and "P'' τ  P'''"
                         and "P''' τ P'"
    by(blast dest: transitionE)
  thus "P τ P'" by auto
next
  assume "P τ P'" and "P  P'" 
  thus "P lτ  P'"
  proof(induct rule: tauChainInduct)
    case id
    thus ?case by simp
  next
    case(ih P'' P''')
    have "P τ P''" and "P''  τ  P'''" by fact+
    moreover have "P''' τ P'''" by simp
    ultimately show ?case by(rule transitionI)
  qed
qed

lemma singleActionChain:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   α  :: freeRes
  and   u  :: name
 
  shows "P ax>  P'  P lax>  P'"
  and   "P a<x>  P'  P lu in P'a<x>  P'[x::=u]"
  and   "P α  P'  P lα  P'"
proof -  
  assume "P ax>  P'"
  moreover have "P τ P" by simp
  moreover have "P' τ P'" by simp
  ultimately show "P lax>  P'" by(blast intro: transitionI)
next
  assume "P a<x>  P'"
  moreover have "P τ P" by simp
  moreover have "P'[x::=u] τ P'[x::=u]" by simp
  ultimately show "P lu in P'a<x>  P'[x::=u]" by(blast intro: transitionI)
next
  assume "P α  P'"
  moreover have "P τ P" by simp
  moreover have "P' τ P'" by simp
  ultimately show "P lα  P'"  by(blast intro: transitionI)
qed

lemma Tau:
  fixes P :: pi

  shows "τ.(P) l τ   P"
proof -
  have "τ.(P) τ τ.(P)" by simp
  moreover have "τ.(P) τ  P" by(rule transitions.Tau)
  moreover have "P τ P" by simp
  ultimately show ?thesis by(rule transitionI)
qed

lemma Input:
  fixes a :: name
  and   x :: name
  and   u :: name
  and   P :: pi

  shows "a<x>.P lu in Pa<x>  P[x::=u]"
proof -
  have "a<x>.P τ a<x>.P" by simp
  moreover have "a<x>.P  a<x>  P" by(rule Input)
  moreover have "P[x::=u] τ P[x::=u]" by simp
  ultimately show ?thesis by(rule transitionI)
qed

lemma Output:
  fixes a :: name
  and   b :: name
  and   P :: pi

  shows "a{b}.P la[b]  P"
proof -
  have "a{b}.P τ a{b}.P" by simp
  moreover have "a{b}.P a[b]  P" by(rule transitions.Output)
  moreover have "P τ P" by simp
  ultimately show ?thesis by(rule transitionI)
qed

lemma Match:
  fixes P  :: pi
  and   Rs :: residual
  and   a  :: name
  and   u  :: name
  and   b  :: name
  and   x  :: name
  and   P' :: pi

  shows "P l Rs  [aa]P l Rs"
  and   "P lu in P''b<x>  P'  [aa]P lu in P''b<x>  P'"
proof -
  assume PTrans: "P l Rs"
  thus "[aa]P l Rs"
  proof(nominal_induct avoiding: P rule: residual.strong_inducts)
    case(BoundR b x P')
    have PTrans: "P l b«x»  P'" and xFreshP: "x  P" by fact+
    from PTrans obtain b' where beq: "b = BoundOutputS b'" by(cases b) auto
    with PTrans xFreshP obtain P'' P''' where PTrans: "P τ P''"
                                          and P''Trans: "P'' b'x>  P'''"
                                          and P'''Trans: "P''' τ P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "[aa]P τ [aa]P" by simp
      moreover from P''Trans have "[aa]P''  b'x>  P'''" by(rule Match)
      ultimately show ?thesis using beq P'''Trans by(blast intro: transitionI)
    next
      assume "P  P''"
      with PTrans have "[aa]P τ P''" by(rule matchChain)
      thus ?thesis using beq P''Trans P'''Trans by(blast intro: transitionI)
    qed
  next
    case(FreeR α P')
    have "P l α  P'" by fact

    then obtain P'' P''' where PTrans: "P τ P''"
                           and P''Trans: "P''  α  P'''"
                           and P'''Trans: "P''' τ P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "[aa]P τ [aa]P" by simp
      moreover from P''Trans have "[aa]P''  α  P'''" by(rule transitions.Match)
      ultimately show ?thesis using P'''Trans by(blast intro: transitionI)
    next
      assume "P  P''"
      with PTrans have "[aa]P τ P''" by(rule matchChain)
      thus ?thesis using P''Trans P'''Trans by(rule transitionI)
    qed
  qed
next
  assume "P lu in P''b<x>  P'"
  then obtain P''' where PChain: "P τ P'''"
                     and P'''Trans: "P''' b<x>  P''"
                     and P''Chain: "P''[x::=u] τ P'"
    by(blast dest: transitionE)
  show "[aa]P lu in P''b<x>  P'"
  proof(cases "P=P'''")
    assume "P=P'''"
    moreover have "[aa]P τ [aa]P" by simp
    moreover from P'''Trans have "[aa]P''' b<x>  P''" by(rule Late_Semantics.Match)
    ultimately show ?thesis using P''Chain by(blast intro: transitionI)
  next
    assume "P  P'''"
    with PChain have "[aa]P τ P'''" by(rule matchChain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
qed

lemma Mismatch:
  fixes P  :: pi
  and   Rs :: residual
  and   a  :: name
  and   c  :: name
  and   u  :: name
  and   b  :: name
  and   x  :: name
  and   P' :: pi

  shows "P l Rs; a  c  [ac]P l Rs"
  and   "P lu in P''b<x>  P'; a  c  [ac]P lu in P''b<x>  P'"
proof -
  assume PTrans: "P l Rs"
     and aineqc: "a  c"
  thus "[ac]P l Rs"
  proof(nominal_induct avoiding: P rule: residual.strong_inducts)
    case(BoundR b x P')
    have PTrans: "P l b«x»  P'" and xFreshP: "x  P" by fact+
    from PTrans obtain b' where beq: "b = BoundOutputS b'" by(cases b, auto)
    with PTrans xFreshP obtain P'' P''' where PTrans: "P τ P''"
                                          and P''Trans: "P'' b'x>  P'''"
                                          and P'''Trans: "P''' τ P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "[ac]P τ [ac]P" by simp
      moreover from P''Trans aineqc have "[ac]P'' b'x>  P'''" by(rule transitions.Mismatch)
      ultimately show ?thesis using beq P'''Trans by(blast intro: transitionI)
    next
      assume "P  P''"
      with PTrans aineqc have "[ac]P τ P''" by(rule mismatchChain)
      thus ?thesis using beq P''Trans P'''Trans by(blast intro: transitionI)
    qed
  next
    case(FreeR α P')
    have "P l α  P'" by fact

    then obtain P'' P''' where PTrans: "P τ P''"
                           and P''Trans: "P''  α  P'''"
                           and P'''Trans: "P''' τ P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "[ac]P τ [ac]P" by simp
      moreover from P''Trans a  c have "[ac]P''  α  P'''" by(rule transitions.Mismatch)
      ultimately show ?thesis using P'''Trans by(blast intro: transitionI)
    next
      assume "P  P''"
      with PTrans aineqc have "[ac]P τ P''" by(rule mismatchChain)
      thus ?thesis using P''Trans P'''Trans by(rule transitionI)
    qed
  qed
next
  assume aineqc: "a  c"
  assume "P lu in P''b<x>  P'"
  then obtain P''' where PChain: "P τ P'''"
                     and P'''Trans: "P''' b<x>  P''"
                     and P''Chain: "P''[x::=u] τ P'"
    by(blast dest: transitionE)
  show "[ac]P lu in P''b<x>  P'"
  proof(cases "P=P'''")
    assume "P=P'''"
    moreover have "[ac]P τ [ac]P" by simp
    moreover from P'''Trans aineqc have "[ac]P''' b<x>  P''" by(rule Late_Semantics.Mismatch)
    ultimately show ?thesis using P''Chain by(blast intro: transitionI)
  next
    assume "P  P'''"
    with PChain aineqc have "[ac]P τ P'''" by(rule mismatchChain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
qed

lemma Open:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes Trans:  "P la[b]  P'"
  and     aInEqb: "a  b"

  shows "b>P lab>  P'"
proof -
  from Trans obtain P'' P''' where A: "P τ P''"
                               and B: "P'' a[b]  P'''"
                               and C: "P''' τ P'"
    by(force dest: transitionE)
  from A have "b>P τ b>P''" by(rule ResChain)
  moreover from B aInEqb have "b>P'' ab>  P'''" by(rule Open)
  ultimately show ?thesis using C by(force simp add: transition_def)
qed

lemma Sum1:
  fixes P   :: pi
  and   Rs  :: residual
  and   Q   :: pi
  and   u   :: name
  and   P'' :: pi
  and   a   :: name
  and   x   :: name
  and   P'  :: pi

  shows "P l Rs  P  Q l Rs"
  and   "P lu in P''a<x>  P'  P  Q lu in P''a<x>  P'"
proof -
  assume "P l Rs"
  thus "P  Q l Rs"
  proof(nominal_induct avoiding: P rule: residual.strong_inducts)
    case(BoundR a x P' P)
    have PTrans: "P la«x»  P'"
     and xFreshP: "x  P" by fact+
    from PTrans obtain a' where aeq: "a = BoundOutputS a'" by(cases a, auto)
    with PTrans xFreshP obtain P'' P''' where PTrans: "P τ P''"
                                          and P''Trans: "P'' a'x>  P'''"
                                          and P'''Trans: "P''' τ P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "P  Q τ P  Q" by simp
      moreover from P''Trans have "P''  Q a'x>  P'''" by(rule transitions.Sum1)
      ultimately show ?thesis using P'''Trans aeq by(blast intro: transitionI)
    next
      assume "P  P''"
      with PTrans have "P  Q τ P''" by(rule sum1Chain)
      thus ?thesis using P''Trans P'''Trans aeq by(blast intro: transitionI)
    qed
  next
    case(FreeR α P')
    have "P l α  P'" by fact

    then obtain P'' P''' where PTrans: "P τ P''"
                           and P''Trans: "P''  α  P'''"
                           and P'''Trans: "P''' τ P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "P  Q τ P  Q" by simp
      moreover from P''Trans have "P''  Q  α  P'''" by(rule transitions.Sum1)
      ultimately show ?thesis using P'''Trans by(blast intro: transitionI)
    next
      assume "P  P''"
      with PTrans have "P  Q τ P''" by(rule sum1Chain)
      thus ?thesis using P''Trans P'''Trans by(rule transitionI)
    qed
  qed
next
  assume "P lu in P''a<x>  P'"
  then obtain P''' where PChain: "P τ P'''"
                     and P'''Trans: "P''' a<x>  P''"
                     and P''Chain: "P''[x::=u] τ P'"
    by(blast dest: transitionE)
  show "P  Q lu in P''a<x>  P'"
  proof(cases "P = P'''")
    assume "P = P'''"
    moreover have "P  Q τ P  Q" by simp
    moreover from P'''Trans have "P'''  Q a<x>  P''" by(rule transitions.Sum1)
    ultimately show ?thesis using P''Chain by(blast intro: transitionI)
  next
    assume "P  P'''"
    with PChain have "P  Q τ P'''" by(rule sum1Chain)
    thus ?thesis using P'''Trans P''Chain by(blast intro: transitionI)
  qed
qed

lemma Sum2:
  fixes Q  :: pi
  and   Rs :: residual
  and   P  :: pi
  and   u  :: name
  and   Q'' :: pi
  and   a  :: name
  and   x  :: name
  and   Q' :: pi

  shows "Q l Rs  P  Q l Rs"
  and   "Q lu in Q''a<x>  Q'  P  Q lu in Q''a<x>  Q'"
proof -
  assume "Q l Rs"
  thus "P  Q l Rs"
  proof(nominal_induct avoiding: Q rule: residual.strong_inducts)
    case(BoundR a x Q' Q)
    have QTrans: "Q la«x»  Q'"
     and xFreshQ: "x  Q" by fact+
    from QTrans obtain a' where aeq: "a = BoundOutputS a'" by(cases a, auto)
    with QTrans xFreshQ obtain Q'' Q''' where QTrans: "Q τ Q''"
                                          and Q''Trans: "Q'' a'x>  Q'''"
                                          and Q'''Trans: "Q''' τ Q'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "Q = Q''")
      assume "Q = Q''"
      moreover have "P  Q τ P  Q" by simp
      moreover from Q''Trans have "P  Q'' a'x>  Q'''" by(rule transitions.Sum2)
      ultimately show ?thesis using Q'''Trans aeq by(blast intro: transitionI)
    next
      assume "Q  Q''"
      with QTrans have "P  Q τ Q''" by(rule sum2Chain)
      thus ?thesis using Q''Trans Q'''Trans aeq by(blast intro: transitionI)
    qed
  next
    case(FreeR α Q')
    have "Q l α  Q'" by fact

    then obtain Q'' Q''' where QTrans: "Q τ Q''"
                           and Q''Trans: "Q''  α  Q'''"
                           and Q'''Trans: "Q''' τ Q'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "Q = Q''")
      assume "Q = Q''"
      moreover have "P  Q τ P  Q" by simp
      moreover from Q''Trans have "P  Q''  α  Q'''" by(rule transitions.Sum2)
      ultimately show ?thesis using Q'''Trans by(blast intro: transitionI)
    next
      assume "Q  Q''"
      with QTrans have "P  Q τ Q''" by(rule sum2Chain)
      thus ?thesis using Q''Trans Q'''Trans by(rule transitionI)
    qed
  qed
next
  assume "Q lu in Q''a<x>  Q'"
  then obtain Q''' where QChain: "Q τ Q'''"
                     and Q'''Trans: "Q''' a<x>  Q''"
                     and Q''Chain: "Q''[x::=u] τ Q'"
    by(blast dest: transitionE)
  show "P  Q lu in Q''a<x>  Q'"
  proof(cases "Q = Q'''")
    assume "Q = Q'''"
    moreover have "P  Q τ P  Q" by simp
    moreover from Q'''Trans have "P  Q''' a<x>  Q''" by(rule transitions.Sum2)
    ultimately show ?thesis using Q''Chain by(blast intro: transitionI)
  next
    assume "Q  Q'''"
    with QChain have "P  Q τ Q'''" by(rule sum2Chain)
    thus ?thesis using Q'''Trans Q''Chain by(blast intro: transitionI)
  qed
qed

lemma Par1B:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   u  :: name
  and   P'' :: pi

  shows "P lax>  P'; x  Q  P  Q lax>  (P'  Q)"
  and   "P lu in P''a<x>  P'; x  Q  P  Q lu in (P''  Q)a<x>  P'  Q"
proof -
  assume PTrans: "P l ax>  P'"
  assume xFreshQ: "x  Q"

  have Goal: "P a x P' Q. P lax>  P'; x  P; x  Q  P  Q lax>  (P'  Q)"
  proof -
    fix P a x P' Q
    assume PTrans: "P lax>  P'"
    assume xFreshP: "x  P"
    assume xFreshQ: "x  (Q::pi)"

    from PTrans xFreshP obtain P'' P''' where PTrans: "P τ P''"
                                          and P''Trans: "P'' ax>  P'''"
                                          and P'''Trans: "P''' τ P'"
      by(blast dest: transitionE)
    from PTrans have "P  Q τ P''  Q" by(rule Par1Chain)
    moreover from P''Trans xFreshQ have "P''  Q ax>  (P'''  Q)" by(rule Par1B)
    moreover from P'''Trans have "P'''  Q τ P'  Q" by(rule Par1Chain)
    ultimately show "P  Q lax>  (P'  Q)" by(rule transitionI)
  qed
  
  have "c::name. c  (P, P', Q)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshP': "c  P'" and cFreshQ: "c  Q"
    by(force simp add: fresh_prod)

  from cFreshP' have "ax>  P' = ac>  ([(x, c)]  P')" by(rule alphaBoundResidual)
  moreover have "ax>  (P'  Q) = ac>  (([(x, c)]  P')  Q)"
  proof -
    from cFreshP' cFreshQ have "c  P'  Q" by simp
    hence "ax>  (P'  Q) = ac>  ([(x, c)]  (P'  Q))" by(rule alphaBoundResidual)
    with cFreshQ xFreshQ show ?thesis by(simp add: name_fresh_fresh)
  qed
  ultimately show "P  Q l ax>  P'  Q" using PTrans cFreshP cFreshQ by(force intro: Goal)
next
  assume PTrans: "P lu in P''a<x>  P'"
     and xFreshQ: "x  Q"
  from PTrans obtain P''' where PChain: "P τ P'''"
                            and P'''Trans: "P''' a<x>  P''"
                            and P''Chain: "P''[x::=u] τ P'"
    by(blast dest: transitionE)
  from PChain have "P  Q τ P'''  Q" by(rule Par1Chain)
  moreover from P'''Trans xFreshQ have "P'''  Q a<x>  (P''  Q)" by(rule Par1B)
  moreover have "(P''  Q)[x::=u] τ P'  Q"
  proof - 
    from P''Chain have "P''[x::=u]  Q τ P'  Q" by(rule Par1Chain)
    with xFreshQ show ?thesis by(simp add: forget)
  qed
  ultimately show "P  Q lu in (P''  Q)a<x>  (P'  Q)" by(rule transitionI)
qed

lemma Par1F:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi

  assumes PTrans: "P lα  P'"

  shows "P  Q lα  (P'  Q)"
proof -
  from PTrans obtain P'' P''' where PTrans: "P τ P''"
                                and P''Trans: "P'' α  P'''"
                                and P'''Trans: "P''' τ P'"
    by(blast dest: transitionE)
  from PTrans have "P  Q τ P''  Q" by(rule Par1Chain)
  moreover from P''Trans have "P''  Q α  (P'''  Q)" by(rule transitions.Par1F)
  moreover from P'''Trans have "P'''  Q τ P'  Q" by(rule Par1Chain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Par2B:
  fixes Q  :: pi
  and   a  :: name
  and   x  :: name
  and   Q' :: pi
  and   P  :: pi
  and   u  :: name
  and   Q'' :: pi

  shows "Q lax>  Q'  x  P  P  Q lax>  (P  Q')"
  and   "Q lu in Q''a<x>  Q'  x  P  P  Q lu in (P  Q'')a<x>  P  Q'"
proof -
  assume QTrans: "Q l ax>  Q'"
  assume xFreshP: "x  P"

  have Goal: "Q a x Q' P. Q lax>  Q'; x  Q; x  P  P  Q lax>  (P  Q')"
  proof -
    fix Q a x Q' P
    assume QTrans: "Q lax>  Q'"
    assume xFreshQ: "x  Q"
    assume xFreshP: "x  (P::pi)"

    from QTrans xFreshQ obtain Q'' Q''' where QTrans: "Q τ Q''"
                                          and Q''Trans: "Q'' ax>  Q'''"
                                          and Q'''Trans: "Q''' τ Q'"
      by(blast dest: transitionE)
    from QTrans have "P  Q τ P  Q''" by(rule Par2Chain)
    moreover from Q''Trans xFreshP have "P  Q'' ax>  (P  Q''')" by(rule Par2B)
    moreover from Q'''Trans have "P  Q''' τ P  Q'" by(rule Par2Chain)
    ultimately show "P  Q lax>  (P  Q')" by(rule transitionI)
  qed
  
  have "c::name. c  (Q, Q', P)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshQ: "c  Q" and cFreshQ': "c  Q'" and cFreshP: "c  P"
    by(force simp add: fresh_prod)

  from cFreshQ' have "ax>  Q' = ac>  ([(x, c)]  Q')" by(rule alphaBoundResidual)
  moreover have "ax>  (P  Q') = ac>  (P  ([(x, c)]  Q'))"
  proof -
    from cFreshQ' cFreshP have "c  P  Q'" by simp
    hence "ax>  (P  Q') = ac>  ([(x, c)]  (P  Q'))" by(rule alphaBoundResidual)
    with cFreshP xFreshP show ?thesis by(simp add: name_fresh_fresh)
  qed
  ultimately show "P  Q l ax>  P  Q'" using QTrans cFreshQ cFreshP by(force intro: Goal)
next
  assume QTrans: "Q lu in Q''a<x>  Q'"
     and xFreshP: "x  P"
  from QTrans obtain Q''' where QChain: "Q τ Q'''"
                            and Q'''Trans: "Q''' a<x>  Q''"
                            and Q''Chain: "Q''[x::=u] τ Q'"
    by(blast dest: transitionE)
  from QChain have "P  Q τ P  Q'''" by(rule Par2Chain)
  moreover from Q'''Trans xFreshP have "P  Q''' a<x>  (P  Q'')" by(rule Par2B)
  moreover have "(P  Q'')[x::=u] τ P  Q'"
  proof - 
    from Q''Chain have "P  (Q''[x::=u]) τ P  Q'" by(rule Par2Chain)
    with xFreshP show ?thesis by(simp add: forget)
  qed
  ultimately show "P  Q lu in (P  Q'')a<x>  (P  Q')" by(rule transitionI)
qed

lemma Par2F:
  fixes Q :: pi
  and   α  :: freeRes
  and   Q' :: pi

  assumes QTrans: "Q lα  Q'"

  shows "P  Q lα  (P  Q')"
proof -
  from QTrans obtain Q'' Q''' where QTrans: "Q τ Q''"
                                and Q''Trans: "Q'' α  Q'''"
                                and Q'''Trans: "Q''' τ Q'"
    by(blast dest: transitionE)
  from QTrans have "P  Q τ P  Q''" by(rule Par2Chain)
  moreover from Q''Trans have "P  Q'' α  (P  Q''')" by(rule transitions.Par2F)
  moreover from Q'''Trans have "P  Q''' τ P  Q'" by(rule Par2Chain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Comm1:
  fixes P  :: pi
  and   b  :: name
  and   P'' :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi
  
  assumes PTrans: "P lb in P'' a<x>  P'"
  and     QTrans: "Q la[b]  Q'"

  shows "P  Q lτ  P'  Q'"
proof -
  from PTrans obtain P''' where PChain: "P τ P'''"
                            and P'''Trans: "P''' a<x>  P''"
                            and P''Chain: "P''[x::=b] τ P'"
    by(blast dest: transitionE)
  from QTrans obtain Q'' Q''' where QChain: "Q τ Q'''"
                                and Q'''Trans: "Q''' a[b]  Q''"
                                and Q''Chain: "Q'' τ Q'"
    by(blast dest: transitionE)

  from PChain QChain have "P  Q τ P'''  Q'''" by(rule chainPar)
  moreover from P'''Trans Q'''Trans have "P'''  Q''' τ  P''[x::=b]  Q''"
    by(rule Comm1)
  moreover from P''Chain Q''Chain have "P''[x::=b]  Q'' τ P'  Q'" by(rule chainPar)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Comm2:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   Q  :: pi
  and   x  :: name
  and   Q'' :: pi
  and   Q' :: pi
  
  assumes PTrans: "P la[b]  P'"
  and     QTrans: "Q lb in Q''a<x>  Q'"

  shows "P  Q lτ  P'  Q'"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' a[b]  P''"
                                and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)
  from QTrans obtain Q''' where QChain: "Q τ Q'''"
                            and Q'''Trans: "Q''' a<x>  Q''"
                            and Q''Chain: "Q''[x::=b] τ Q'"
    by(blast dest: transitionE)

  from PChain QChain have "P  Q τ P'''  Q'''" by(rule chainPar)
  moreover from P'''Trans Q'''Trans have "P'''  Q''' τ  P''  (Q''[x::=b])"
    by(rule Comm2)
  moreover from P''Chain Q''Chain have "P''  (Q''[x::=b]) τ P'  Q'" by(rule chainPar)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Close1:
  fixes P  :: pi
  and   y  :: name
  and   P'' :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi
  
  assumes PTrans: "P ly in P''a<x>  P'"
  and     QTrans: "Q lay>  Q'"
  and     yFreshP: "y  P"
  and     yFreshQ: "y  Q"

  shows "P  Q lτ  y>(P'  Q')"
proof -
  from PTrans obtain P''' where PChain: "P τ P'''"
                            and P'''Trans: "P''' a<x>  P''"
                            and P''Chain: "P''[x::=y] τ P'"
    by(blast dest: transitionE)
  from QTrans yFreshQ obtain Q'' Q''' where QChain: "Q τ Q'''"
                                        and Q'''Trans: "Q''' ay>  Q''"
                                        and Q''Chain: "Q'' τ Q'"
    by(blast dest: transitionE)
  
  from PChain yFreshP have yFreshP''': "y  P'''" by(rule freshChain)
  
  from PChain QChain have "P  Q τ P'''  Q'''" by(rule chainPar)
  moreover from P'''Trans Q'''Trans yFreshP''' have "P'''  Q''' τ  y>(P''[x::=y]  Q'')"
    by(rule Close1)
  moreover have "y>(P''[x::=y]  Q'') τ y>(P'  Q')"
  proof -
    from P''Chain Q''Chain have "P''[x::=y]  Q'' τ P'  Q'" by(rule chainPar)
    thus ?thesis by(rule ResChain)
  qed
  ultimately show "P  Q lτ  y>(P'  Q')" by(rule transitionI)
qed

lemma Close2:
  fixes P  :: pi
  and   y  :: name
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q'' :: pi
  and   Q' :: pi
  
  assumes PTrans: "P lay>  P'"
  and     QTrans: "Q ly in Q''a<x>  Q'"
  and     yFreshP: "y  P"
  and     yFreshQ: "y  Q"

  shows "P  Q lτ  y>(P'  Q')"
proof -
  from PTrans yFreshP obtain P'' P''' where PChain: "P τ P'''"
                                        and P'''Trans: "P''' ay>  P''"
                                        and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)

  from QTrans obtain Q''' where QChain: "Q τ Q'''"
                            and Q'''Trans: "Q''' a<x>  Q''"
                            and Q''Chain: "Q''[x::=y] τ Q'"
    by(blast dest: transitionE)
  
  from QChain yFreshQ have yFreshQ''': "y  Q'''" by(rule freshChain)
  
  from PChain QChain have "P  Q τ P'''  Q'''" by(rule chainPar)
  moreover from P'''Trans Q'''Trans yFreshQ''' have "P'''  Q''' τ  y>(P''  (Q''[x::=y]))"
    by(rule Close2)
  moreover have "y>(P''  (Q''[x::=y])) τ y>(P'  Q')"
  proof -
    from P''Chain Q''Chain have "P''  (Q''[x::=y]) τ P'  Q'" by(rule chainPar)
    thus ?thesis by(rule ResChain)
  qed
  ultimately show "P  Q lτ  y>(P'  Q')" by(rule transitionI)
qed

lemma ResF:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   x  :: name

  assumes PTrans: "P lα  P'"
  and     xFreshAlpha: "x  α"

  shows "x>P lα  x>P'"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P''"
                                and P''Trans: "P'' α  P'''"
                                and P'''Chain: "P''' τ P'"
    by(blast dest: transitionE)

  from PChain have "x>P τ x>P''" by(rule ResChain)
  moreover from P''Trans xFreshAlpha have "x>P'' α  x>P'''"
    by(rule transitions.ResF)
  moreover from P'''Chain have "x>P''' τ x>P'" by(rule ResChain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma ResB:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   y  :: name
  and   u  :: name
  and   P'' :: pi

  shows "P lax>  P'; y  a; y  x; x  P  y>P lax>  (y>P')"
  and   "P lu in P''a<x>  P'; y  a; y  x; y  u  y>P lu in (y>P'')a<x>  (y>P')"
proof -
  assume PTrans: "P lax>  P'"
     and yineqa: "y  a"
     and yineqx: "y  x"
     and xFreshP: "x  P"

  from PTrans xFreshP obtain P'' P''' where PChain: "P τ P''"
                                        and P''Trans: "P'' ax>  P'''"
                                        and P'''Chain: "P''' τ P'"
    by(blast dest: transitionE)

  from PChain have "y>P τ y>P''" by(rule ResChain)
  moreover from P''Trans yineqa yineqx have "y>P'' ax>  (y>P''')"
    by(force intro: ResB)
  moreover from P'''Chain have "y>P''' τ y>P'" by(rule ResChain)
  ultimately show "y>P l ax>  y>P'" by(rule transitionI)
next
  assume PTrans: "P lu in P''a<x>  P'"
     and yineqa: "y  a"
     and yineqx: "y  x"
     and yinequ: "y  u" 

  from PTrans obtain P''' where PChain: "P τ P'''"
                            and P'''Trans: "P''' a<x>  P''"
                            and P''Chain: "P''[x::=u] τ P'"
    by(blast dest: transitionE)

  from PChain have "y>P τ y>P'''" by(rule ResChain)
  moreover from P'''Trans yineqa yineqx have "y>P''' a<x>  (y>P'')"
    by(force intro: ResB)
  moreover have "(y>P'')[x::=u] τ y>P'"
  proof -
    from P''Chain have "y>(P''[x::=u]) τ y>P'" by(rule ResChain)
    with yineqx yinequ show ?thesis by(simp add: eqvt_subs[THEN sym])
  qed
  ultimately show "y>P lu in (y>P'')a<x>  y>P'" by(rule transitionI)
qed

lemma Bang:
  fixes P  :: pi
  and   Rs :: residual
  and   u  :: name
  and   P'' :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi

  shows "P  !P l Rs  !P l Rs"
  and   "P  !P lu in P''a<x>  P'  !P lu in P''a<x>  P'"
proof -
  assume "P  !P l Rs"
  thus "!P l Rs"
  proof(nominal_induct avoiding: P rule: residual.strong_inducts)
    case(BoundR a x P' P)
    assume xFreshP: "x  P"
    assume PTrans: "P  !P la«x»  P'"
    from PTrans obtain a' where aeq: "a = BoundOutputS a'" by(cases a, auto)

    with PTrans xFreshP obtain P'' P''' where PChain: "P  !P τ P''"
                                          and P''Trans: "P'' a'x>  P'''"
                                          and P'''Chain: "P''' τ P'"
      by(force dest: transitionE)

    show "!P la«x»  P'"
    proof(cases "P'' = P  !P")
      assume "P'' = P  !P"
      moreover with P''Trans have "!P a'x>  P'''" by(blast intro: transitions.Bang)
      ultimately show ?thesis using PChain P'''Chain aeq by(simp, rule_tac transitionI, auto)
    next
      assume "P''  P  !P"
      with PChain have "!P τ P''" by(rule bangChain)
      with P''Trans P'''Chain aeq show ?thesis by(blast intro: transitionI)
    qed
  next
    fix α P' P
    assume "P  !P lα  P'"
    
    then obtain P'' P''' where PChain: "P  !P τ P''"
                           and P''Trans: "P'' α  P'''"
                           and P'''Chain: "P''' τ P'"
      by(force dest: transitionE)


    show "!P lα  P'"
    proof(cases "P'' = P  !P")
      assume "P'' = P  !P"
      moreover with P''Trans have "!P α  P'''" by(blast intro: transitions.Bang)
      ultimately show ?thesis using PChain P'''Chain by(rule_tac transitionI, auto)
    next
      assume "P''  P  !P"
      with PChain have "!P τ P''" by(rule bangChain)
      with P''Trans P'''Chain show ?thesis by(blast intro: transitionI)
    qed
  qed
next
  assume "P  !P lu in P''a<x>  P'"

  then obtain P''' where PChain: "P  !P τ P'''"
                     and P'''Trans: "P''' a<x>  P''"
                     and P''Chain: "P''[x::=u] τ P'"
    by(force dest: transitionE)
  
  show "!P lu in P''a<x>  P'"
  proof(cases "P''' = P  !P")
    assume "P''' = P  !P"
    moreover with P'''Trans have "!P a<x>  P''" by(blast intro: transitions.Bang)
    ultimately show ?thesis using PChain P''Chain by(rule_tac transitionI, auto)
  next
    assume "P'''  P  !P"
    with PChain have "!P τ P'''" by(rule bangChain)
    with P'''Trans P''Chain show ?thesis by(blast intro: transitionI)
  qed
qed

lemma tauTransitionChain:
  fixes P  :: pi
  and   P' :: pi

  assumes "P lτ  P'"

  shows "P τ P'"
using assms
by(auto simp add: transition_def residualInject)

lemma chainTransitionAppend:
  fixes P   :: pi
  and   P'  :: pi
  and   Rs  :: residual
  and   a   :: name
  and   x   :: name
  and   P'' :: pi
  and   u   :: name
  and   P''' :: pi
  and   α   :: freeRes

  shows "P τ P'  P' l Rs  P l Rs"
  and   "P τ P''  P'' lu in P'''a<x>  P'  P lu in P'''a<x>  P'"
  and   "P lax>  P''  P'' τ P'  x  P  P lax>  P'"
  and   "P lu in P'''a<x>  P''  P'' τ P'  P lu in P'''a<x>  P'"
  and   "P lα  P''  P'' τ P'  P lα  P'"
proof -
  assume "P τ P'" and "P' l Rs"
  thus "P l Rs"
    by(auto simp add: transition_def residualInject) (blast dest: rtrancl_trans)+
next
  assume "P τ P''" and "P'' lu in P'''a<x>  P'"
  thus "P lu in P'''a<x>  P'"
    apply(auto simp add: inputTransition_def residualInject)
    by(blast dest: rtrancl_trans)+
next
  assume PTrans: "P l ax>  P''" 
  assume P''Chain: "P'' τ P'"
  assume xFreshP: "x  P"

  from PTrans xFreshP obtain P''' P'''' where PChain: "P τ P'''"
                                          and P'''Trans: "P''' ax>  P''''"
                                          and P''''Chain: "P'''' τ P''"
    by(blast dest: transitionE)

  from P''''Chain P''Chain have "P'''' τ P'" by auto
  with PChain P'''Trans show "P lax>  P'" by(rule transitionI)
next
  assume PTrans: "P lu in P'''a<x>  P''" 
  assume P''Chain: "P'' τ P'"

  from PTrans obtain P'''' where PChain: "P τ P''''"
                             and P''''Trans: "P'''' a<x>  P'''"
                             and P'''Chain: "P'''[x::=u] τ P''"
    by(blast dest: transitionE)

  from P'''Chain P''Chain have "P'''[x::=u] τ P'" by auto
  with PChain P''''Trans show "P lu in P'''a<x>  P'" by(blast intro: transitionI)
next
  assume PTrans: "P lα  P''" 
  assume P''Chain: "P'' τ P'"

  from PTrans obtain P''' P'''' where PChain: "P τ P'''"
                                  and P'''Trans: "P''' α  P''''"
                                  and P''''Chain: "P'''' τ P''"
    by(blast dest: transitionE)

  from P''''Chain P''Chain have "P'''' τ P'" by auto
  with PChain P'''Trans show "P lα  P'" by(rule transitionI)
qed

lemma freshInputTransition:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   u  :: name
  and   P'' :: pi
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P lu in P''a<x>  P'"
  and     cFreshP: "c  P"
  and     cinequ: "c  u"

  shows "c  P'"
proof -

  from PTrans obtain P''' where PChain: "P τ P'''"
                            and P'''Trans: "P''' a<x>  P''"
                            and P''Chain: "P''[x::=u] τ P'"
    by(blast dest: transitionE)

  from PChain cFreshP have cFreshP''': "c  P'''" by(rule freshChain)
  show "c  P'"
  proof(cases "x=c")
    assume xeqc: "x=c"
    from cinequ have "c  P''[c::=u]" apply - by(rule fresh_fact2)
    with P''Chain xeqc show ?thesis by(force intro: freshChain)
  next
    assume xineqc: "xc"
    with P'''Trans cFreshP''' have "c  P''" by(blast dest: freshBoundDerivative)
    with cinequ have "c  P''[x::=u]"
      apply -
      apply(rule fresh_fact1)
      by simp
    with P''Chain show ?thesis by(rule freshChain)
  qed
qed

lemma freshBoundOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P lax>  P'"
  and     cFreshP: "c  P"
  and     cineqx: "c  x"

  shows "c  P'"
proof -
  have Goal: "P a x P' c. P lax>  P'; x  P; c  P; c  x  c  P'"
  proof -
    fix P a x P' c
    assume PTrans: "P lax>  P'"
    assume xFreshP: "x  P"
    assume cFreshP: "(c::name)  P"
    assume cineqx: "c  x"

    from PTrans xFreshP obtain P'' P''' where PTrans: "P τ P''"
                                          and P''Trans: "P'' ax>  P'''"
                                          and P'''Trans: "P''' τ P'"
      by(blast dest: transitionE)

    from PTrans cFreshP have "c  P''" by(rule freshChain)
    with P''Trans cineqx have "c  P'''" by(blast dest: Late_Semantics.freshBoundDerivative)
    with P'''Trans show "c  P'" by(rule freshChain)
  qed

  have "d::name. d  (P, P', c)" by(blast intro: name_exists_fresh)
  then obtain d::name where dFreshP: "d  P" and dFreshP': "d  P'" and cineqd: "c  d"
    by(force simp add: fresh_prod)

  from PTrans dFreshP' have "P lad>  ([(x, d)]  P')" by(simp add: alphaBoundResidual)
  hence "c  [(x, d)]  P'" using dFreshP cFreshP cineqd by(rule Goal)
  with cineqd cineqx show ?thesis by(simp add: name_fresh_left name_calc)
qed

lemma freshTauTransition:
  fixes P :: pi
  and   c :: name

  assumes PTrans: "P lτ  P'"
  and     cFreshP: "c  P"

  shows "c  P'"
proof -
  from PTrans have "P τ P'" by(rule tauTransitionChain)
  thus ?thesis using cFreshP by(rule freshChain)
qed

lemma freshOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P la[b]  P'"
  and     cFreshP: "c  P"

  shows "c  P'"
proof -
  from PTrans obtain P'' P''' where PTrans: "P τ P''"
                                and P''Trans: "P'' a[b]  P'''"
                                and P'''Trans: "P''' τ P'"
      by(blast dest: transitionE)

    from PTrans cFreshP have "c  P''" by(rule freshChain)
    with P''Trans have "c  P'''" by(blast dest: Late_Semantics.freshFreeDerivative)
    with P'''Trans show ?thesis by(rule freshChain)
qed

lemma eqvtI:
  fixes P    :: pi
  and   Rs   :: residual
  and   perm :: "name prm"
  and   u    :: name
  and   P''  :: pi
  and   a    :: name
  and   x    :: name
  and   P'   :: pi

  shows "P l Rs  (perm  P) l (perm  Rs)"
  and   "P lu in P''a<x>  P'  (perm  P) l(perm  u) in (perm  P'')(perm  a)<(perm  x)>  (perm  P')"
proof -
  assume "P l Rs"
  thus "(perm  P) l (perm  Rs)"
  proof(nominal_induct Rs avoiding: P rule: residual.strong_inducts)
    case(BoundR a x P' P)
    have PTrans: "P la«x»  P'" by fact
    moreover then obtain b where aeqb: "a = BoundOutputS b" by(cases a, auto)
    moreover have "x  P" by fact
    ultimately obtain P'' P''' where PTrans: "P τ P''"
                               and P''Trans: "P'' bx>  P'''"
                              and P'''Trans: "P''' τ P'"
      by(blast dest: transitionE)

    from PTrans have "(perm  P) τ (perm  P'')" by(rule eqvtChainI)
    moreover from P''Trans have "(perm  P'')  (perm  (bx>  P'''))"
      by(rule eqvts)
    moreover from P'''Trans have "(perm  P''') τ (perm  P')" by(rule eqvtChainI)
    ultimately show ?case using aeqb by(force intro: transitionI)
  next
    case(FreeR α P' P)
    have "P lα  P'" by fact
    then obtain P'' P''' where PTrans: "P τ P''"
                           and P''Trans: "P'' α  P'''"
                           and P'''Trans: "P''' τ P'"
      by(blast dest: transitionE)

    from PTrans have "(perm  P) τ (perm  P'')" by(rule eqvtChainI)
    moreover from P''Trans have "(perm  P'')  (perm  (α  P'''))"
      by(rule eqvts)
    moreover from P'''Trans have "(perm  P''') τ (perm  P')" by(rule eqvtChainI)
    ultimately show ?case by(force intro: transitionI)
  qed
next
  assume "P lu in P''a<x>  P'"

  then obtain P''' where PChain: "P τ P'''"
                     and P'''Trans: "P''' a<x>  P''"
                     and P''Chain: "P''[x::=u] τ P'"
      by(blast dest: transitionE)

    from PChain have "(perm  P) τ (perm  P''')" by(rule eqvtChainI)
    moreover from P'''Trans have "(perm  P''')  (perm  (a<x>  P''))"
      by(rule eqvts)
    moreover from P''Chain have "(perm  P''[x::=u]) τ (perm  P')" by(rule eqvtChainI)
    ultimately show "(perm  P) l(perm  u) in (perm  P'')(perm  a)<(perm  x)>  (perm  P')"
      by(force intro: transitionI simp add: eqvt_subs[THEN sym] perm_bij)
qed

lemmas freshTransition = freshBoundOutputTransition freshOutputTransition
                         freshInputTransition freshTauTransition


end

Theory Weak_Late_Semantics

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Semantics
  imports Weak_Late_Step_Semantics
begin

definition weakTransition :: "(pi × residual) set"
  where "weakTransition  Weak_Late_Step_Semantics.transition  {x. P. x = (P, τ  P)}"

abbreviation weakLateTransition_judge :: "pi  residual  bool" ("_ l^_" [80, 80] 80)
  where "P l^Rs  (P, Rs)  weakTransition"

lemma transitionI:
  fixes P  :: pi
  and   Rs :: residual
  and   P' :: pi

  shows "P l Rs  P l^Rs"
  and   "P l^τ  P"
proof -
  assume "P l Rs"
  thus "P l^Rs" by(simp add: weakTransition_def)
next
  show "P l^τ  P" by(simp add: weakTransition_def)
qed

lemma transitionCases[consumes 1, case_names Step Stay]:
  fixes P  :: pi
  and   Rs :: residual
  and   P' :: pi

  assumes "P l^ Rs"
  and     "P l Rs  F Rs"
  and     "Rs = τ  P  F (τ  P)"

  shows "F Rs"
using assms
by(auto simp add: weakTransition_def)

lemma singleActionChain:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  
  assumes "P α  P'"
  
  shows "P l^(α  P')"
using assms
by(auto intro: Weak_Late_Step_Semantics.singleActionChain
  simp add: weakTransition_def)

lemma Tau:
  fixes P :: pi

  shows "τ.(P) l^ τ   P"
by(auto intro: Weak_Late_Step_Semantics.Tau
   simp add: weakTransition_def)
  
lemma Output:
  fixes a :: name
  and   b :: name
  and   P :: pi

  shows "a{b}.P l^a[b]  P"
by(auto intro: Weak_Late_Step_Semantics.Output
   simp add: weakTransition_def)

lemma Match:
  fixes a  :: name
  and   P  :: pi
  and   b  :: name
  and   x  :: name
  and   P' :: pi
  and   α  :: freeRes

  shows "P l^bx>  P'  [aa]P l^bx>  P'"
  and   "P l^α  P'  P  P'  [aa]P l^α  P'"
by(auto simp add: residual.inject weakTransition_def intro: Weak_Late_Step_Semantics.Match)

lemma Mismatch:
  fixes a  :: name
  and   c  :: name
  and   P  :: pi
  and   b  :: name
  and   x  :: name
  and   P' :: pi
  and   α  :: freeRes

  shows "P l^bx>  P'; a  c  [ac]P l^bx>  P'"
  and   "P l^α  P'  P  P'  a  c  [ac]P l^α  P'"
by(auto simp add: residual.inject weakTransition_def intro: Weak_Late_Step_Semantics.Mismatch)

lemma Open:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes Trans:  "P l^a[b]  P'"
  and     aInEqb: "a  b"

  shows "b>P l^ab>  P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.Open
  simp add: weakTransition_def residual.inject)

lemma Par1B:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi

  assumes PTrans: "P l^ax>  P'"
  and     xFreshQ: "x  Q"

  shows "P  Q l^ax>  (P'  Q)"
using assms
by(auto intro: Weak_Late_Step_Semantics.Par1B
  simp add: weakTransition_def residual.inject)

lemma Par1F:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi

  assumes PTrans: "P l^α  P'"

  shows "P  Q l^α  (P'  Q)"
using assms
by(auto intro: Weak_Late_Step_Semantics.Par1F
  simp add: weakTransition_def residual.inject)

lemma Par2B:
  fixes Q  :: pi
  and   a  :: name
  and   x  :: name
  and   Q' :: pi

  assumes QTrans: "Q l^ax>  Q'"
  and     xFreshP: "x  P"

  shows "P  Q l^ax>  (P  Q')"
using assms
by(auto intro: Weak_Late_Step_Semantics.Par2B
  simp add: weakTransition_def residual.inject)

lemma Par2F:
  fixes Q :: pi
  and   α  :: freeRes
  and   Q' :: pi

  assumes QTrans: "Q l^α  Q'"

  shows "P  Q l^α  (P  Q')"
using assms
by(auto intro: Weak_Late_Step_Semantics.Par2F
  simp add: weakTransition_def residual.inject)

lemma Comm1:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P'' :: pi
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi
  
  assumes PTrans: "P lb in P''a<x>  P'"
  and     QTrans: "Q l^a[b]  Q'"

  shows "P  Q l^τ  P'  Q'"
using assms
by(auto intro: Weak_Late_Step_Semantics.Comm1
  simp add: weakTransition_def residual.inject)

lemma Comm2:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   Q'' :: pi
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi
  
  assumes PTrans: "P l^a[b]  P'"
  and     QTrans: "Q lb in Q''a<x>  Q'"

  shows "P  Q l^τ  P'  Q'"
using assms
by(auto intro: Weak_Late_Step_Semantics.Comm2
  simp add: weakTransition_def residual.inject)

lemma Close1:
  fixes P  :: pi
  and   y  :: name
  and   P'' :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi
  
  assumes PTrans: "P ly in P''a<x>  P'"
  and     QTrans: "Q l^ay>  Q'"
  and     xFreshP: "y  P"
  and     xFreshQ: "y  Q"

  shows "P  Q l^τ  y>(P'  Q')"
using assms
by(auto intro: Weak_Late_Step_Semantics.Close1
  simp add: weakTransition_def residual.inject)

lemma Close2:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   y  :: name
  and   Q'' :: pi
  and   Q' :: pi
  
  assumes PTrans: "P l^ay>  P'"
  and     QTrans: "Q ly in Q''a<x>  Q'"
  and     xFreshP: "y  P"
  and     xFreshQ: "y  Q"

  shows "P  Q l^τ  y>(P'  Q')"
using assms
by(auto intro: Weak_Late_Step_Semantics.Close2
  simp add: weakTransition_def residual.inject)

lemma ResF:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   x  :: name

  assumes PTrans: "P l^α  P'"
  and     xFreshAlpha: "x  α"

  shows "x>P l^α  x>P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.ResF
  simp add: weakTransition_def residual.inject)

lemma ResB:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   y  :: name

  assumes PTrans: "P l^ax>  P'"
  and     yineqa: "y  a"
  and     yineqx: "y  x"
  and     xFreshP: "x  P"

  shows "y>P l^ax>  (y>P')"
using assms
by(auto intro: Weak_Late_Step_Semantics.ResB
  simp add: weakTransition_def residual.inject)

lemma Bang:
  fixes P  :: pi
  and   Rs :: residual

  assumes "P  !P l^ Rs"
  and     "Rs  τ  P  !P"
  
  shows "!P l^ Rs"
using assms
by(auto intro: Weak_Late_Step_Semantics.Bang
  simp add: weakTransition_def residual.inject)

lemma tauTransitionChain:
  fixes P  :: pi
  and   P' :: pi

  assumes "P l^τ  P'"

  shows "P τ P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.tauTransitionChain
  simp add: weakTransition_def residual.inject transition_def)
  
lemma chainTransitionAppend:
  fixes P   :: pi
  and   P'  :: pi
  and   Rs  :: residual
  and   a   :: name
  and   x   :: name
  and   P'' :: pi
  and   α   :: freeRes

  shows "P τ P'  P' l^ Rs  P l^ Rs"
  and   "P l^ax>  P''  P'' τ P'  x  P  P l^ax>  P'"
  and   "P l^α  P''  P'' τ P'  P l^α  P'"
proof -
  assume "P τ P'" and "P' l^ Rs"
  thus "P l^ Rs"
    by(auto intro: Weak_Late_Step_Semantics.chainTransitionAppend
                   Weak_Late_Step_Semantics.tauActionChain
       simp add: weakTransition_def residual.inject)
next
  assume "P l^ax>  P''" and "P'' τ P'" and "x  P"
  thus "P l^ax>  P'"
    by(auto intro: Weak_Late_Step_Semantics.chainTransitionAppend
       simp add: weakTransition_def residual.inject)
next
  assume "P l^α  P''" and "P'' τ P'"
  thus "P l^α  P'"
    apply(case_tac "P''=P'")
    by(auto dest: Weak_Late_Step_Semantics.chainTransitionAppend
                     Weak_Late_Step_Semantics.tauActionChain
       simp add: weakTransition_def residual.inject)
qed

lemma weakEqWeakTransitionAppend:
  fixes P   :: pi
  and   P'  :: pi
  and   α   :: freeRes
  and   P'' :: pi
  
  assumes PTrans: "P lτ  P'"
  and     P'Trans: "P' l^α  P''"
  
  shows "P lα  P''"
proof(cases "α=τ")
  assume alphaEqTau: "α = τ"
  with P'Trans have "P' τ P''" by(blast intro: tauTransitionChain)
  with PTrans alphaEqTau show ?thesis
    by(blast intro: Weak_Late_Step_Semantics.chainTransitionAppend)
next
  assume alphaIneqTau: "α  τ"
  from PTrans have "P τ P'" by(rule Weak_Late_Step_Semantics.tauTransitionChain)
  moreover from P'Trans alphaIneqTau have "P' lα  P''"
    by(auto simp add: weakTransition_def residual.inject)
  ultimately show ?thesis
    by(rule Weak_Late_Step_Semantics.chainTransitionAppend)
qed
    
lemma freshBoundOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P l^ax>  P'"
  and     cFreshP: "c  P"
  and     cineqx: "c  x"

  shows "c  P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.freshBoundOutputTransition
  simp add: weakTransition_def residual.inject)

lemma freshTauTransition:
  fixes P :: pi
  and   c :: name

  assumes PTrans: "P l^τ  P'"
  and     cFreshP: "c  P"

  shows "c  P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.freshTauTransition
  simp add: weakTransition_def residual.inject)

lemma freshOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P l^a[b]  P'"
  and     cFreshP: "c  P"

  shows "c  P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.freshOutputTransition
  simp add: weakTransition_def residual.inject)

lemma eqvtI:
  fixes P    :: pi
  and   Rs   :: residual
  and   perm :: "name prm"

  assumes "P l^ Rs"

  shows "(perm  P) l^ (perm  Rs)"
using assms
by(auto intro: Weak_Late_Step_Semantics.eqvtI
  simp add: weakTransition_def residual.inject)

lemma freshInputTransition:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P l^a<b>  P'"
  and     cFreshP: "c  P"
  and     cineqb: "c  b"

  shows "c  P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.freshInputTransition
  simp add: weakTransition_def residual.inject)

lemmas freshTransition = freshBoundOutputTransition freshOutputTransition
                         freshInputTransition freshTauTransition

end

Theory Weak_Late_Sim

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Sim
  imports Weak_Late_Semantics Strong_Late_Sim
begin

definition weakSimAct :: "pi  residual  ('a::fs_name)  (pi × pi) set  bool" where
  "weakSimAct P Rs C Rel  (Q' a x. Rs = ax>  Q'  x  C  (P' . P l^ax>  P'  (P', Q')  Rel)) 
                         (Q' a x. Rs = a<x>  Q'  x  C  (P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel)) 
                         (Q' α. Rs = α  Q'  (P'. P l^α  P'  (P', Q')  Rel))"

definition weakSimAux :: "pi  (pi × pi) set  pi  bool" where
  "weakSimAux P Rel Q  (Q' a x. (Q  ax>  Q'  x  P)  (P' . P l^ax>  P'  (P', Q')  Rel)) 
                         (Q' a x. (Q  a<x>  Q'  x  P)  (P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel)) 
                         (Q' α. Q  α  Q'  (P'. P l^α  P'  (P', Q')  Rel))"

definition weakSimulation :: "pi  (pi × pi) set  pi  bool" ("_ ^<_> _" [80, 80, 80] 80) where
  "P ^<Rel> Q  (Rs. Q  Rs  weakSimAct P Rs P Rel)"

lemmas simDef = weakSimAct_def weakSimulation_def

lemma "weakSimAux P Rel Q = weakSimulation P Rel Q"
by(auto simp add: weakSimAux_def simDef)

lemma monotonic: 
  fixes A  :: "(pi × pi) set"
  and   B  :: "(pi × pi) set"
  and   P  :: pi
  and   P' :: pi

  assumes "P ^<A> P'"
  and     "A  B"

  shows "P ^<B> P'"
using assms
apply(auto simp add: simDef)
apply blast
apply(erule_tac x="a<x>  Q'" in allE)
apply(clarsimp)
apply(rotate_tac 4)
apply(erule_tac x=Q' in allE)
apply(erule_tac x=a in allE)
apply(erule_tac x=x in allE)
by blast+

lemma simCasesCont[consumes 1, case_names Bound Input Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   C   :: "'a::fs_name"

  assumes Eqvt:  "eqvt Rel"
  and     Bound: "Q' a x. x  C; Q ax>  Q'  P'. P l^ax>  P'  (P', Q')  Rel"
  and     Input: "Q' a x. x  C; Q a<x>  Q'  P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel"
  and     Free:  "Q' α. Q  α  Q'  (P'. P l^ α  P'  (P', Q')  Rel)"

  shows "P ^<Rel> Q"
using Free 
proof(auto simp add: simDef)
  fix Q' a x
  assume xFreshP: "(x::name)  P"
  assume Trans: "Q  ax>  Q'"
  have "c::name. c  (P, Q', x, C)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshQ': "c  Q'" and cFreshC: "c  C"
                        and cineqx: "c  x"
    by(force simp add: fresh_prod)

  from Trans cFreshQ' have "Q  ac>  ([(x, c)]  Q')" by(simp add: alphaBoundResidual)
  with cFreshC have "P'. P l^ ac>  P'  (P', [(x, c)]  Q')  Rel"
    by(rule Bound)
  then obtain P' where PTrans: "P l^ac>  P'" and P'RelQ': "(P', [(x, c)]  Q')  Rel"
    by blast

  from PTrans xFreshP cineqx have xFreshP': "x  P'" by(force dest: freshTransition)
  with PTrans have "P l^ ax>  ([(x, c)]  P')" by(simp add: alphaBoundResidual name_swap)
  moreover have "([(x, c)]  P', Q')  Rel" (is "?goal")
  proof -
    from Eqvt P'RelQ' have "([(x, c)]  P', [(x, c)]  [(x, c)]  Q')  Rel"
      by(rule eqvtRelI)
    with cineqx show ?goal by(simp add: name_calc)
  qed
  ultimately show "P'. P l^ax>  P'  (P', Q')  Rel" by blast
next
  fix Q' a x u
  assume QTrans: "Q a<x>  (Q'::pi)"and xFreshP: "x  P"

  have "c::name. c  (P, Q', C, x)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshQ': "c  Q'" and cFreshC: "c  C"
                        and cineqx: "c  x"
    by(force simp add: fresh_prod)

  from QTrans cFreshQ' have "Q a<c>  ([(x, c)]  Q')" by(simp add: alphaBoundResidual)
  with cFreshC have "P''. u. P'. P lu in P''a<c>  P'  (P', ([(x, c)]  Q')[c::=u])  Rel"
    by(rule Input)

  then obtain P'' where L1: "u. P'. P lu in P''a<c>  P'  (P', ([(x, c)]  Q')[c::=u])  Rel" by blast
    
  have "u. P'. P lu in ([(c, x)]  P'')a<x>  P'  (P', Q'[x::=u])  Rel"
  proof(auto)
    fix u
    from L1 obtain P' where PTrans: "P lu in P''a<c>  P'" and P'RelQ': "(P', ([(x, c)]  Q')[c::=u])  Rel"
      by blast
      
    from PTrans xFreshP have "P lu in ([(c, x)]  P'')a<x>  P'" by(rule alphaInput) 
    moreover from P'RelQ' cFreshQ' have "(P', Q'[x::=u])  Rel" by(simp add: renaming[THEN sym] name_swap)

    ultimately show "P'. P lu in ([(c, x)]  P'')a<x>  P'  (P', Q'[x::=u])  Rel" by blast
  qed

  thus "P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel" by blast
qed

lemma simCases[case_names Bound Input Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   C   :: "'a::fs_name"

  assumes Bound: "Q' a x. Q ax>  Q'; x  P  P'. P l^ax>  P'  (P', Q')  Rel"
  and     Input: "Q' a x. Q a<x>  Q'; x  P  P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel"
  and     Free:  "Q' α. Q  α  Q'  (P'. P l^ α  P'  (P', Q')  Rel)"

  shows "P ^<Rel> Q"
using assms
by(auto simp add: simDef)

lemma simActBoundCases[consumes 1, case_names Input BoundOutput]:
  fixes P   :: pi
  and   a   :: subject
  and   x   :: name
  and   Q'  :: pi
  and   C   :: "'a::fs_name"
  and   Rel :: "(pi × pi) set"

  assumes EqvtRel: "eqvt Rel"
  and     DerInput: "b. a = InputS b  (P''. u. P'. (P lu in P''b<x>  P')  (P', Q'[x::=u])  Rel)"
  and     DerBoundOutput: "b. a = BoundOutputS b  (P'. (P l^bx>  P')  (P', Q')  Rel)"

  shows "weakSimAct P (a«x»  Q') P Rel"
proof(simp add: weakSimAct_def fresh_prod, auto)
  fix Q'' b y
  assume Eq: "a«x»  Q' = by>  Q''"
  assume yFreshP: "y  P"

  from Eq have "a = BoundOutputS b" by(simp add: residual.inject)

  from yFreshP DerBoundOutput[OF this] Eq show "P'. P l^by>  P'  (P', Q'')  Rel"
  proof(cases "x=y", auto simp add: residual.inject name_abs_eq)
    fix P'
    assume PTrans: "P l^bx>  P'"
    assume P'RelQ': "(P', ([(x, y)]  Q''))  Rel"
    assume xineqy: "x  y"

    with PTrans yFreshP have yFreshP': "y  P'"
      by(force intro: freshTransition)

    hence "bx>  P' = by>  [(x, y)]  P'" by(rule alphaBoundResidual)
    moreover have "([(x, y)]  P', Q'')  Rel"
    proof -
      from EqvtRel P'RelQ' have "([(x, y)]  P', [(x, y)]  ([(x, y)]  Q'')) Rel"
        by(rule eqvtRelI)
      thus ?thesis by(simp add: name_calc)
    qed

    ultimately show "P'. P l^by>  P'  (P', Q'')  Rel" using PTrans by auto
  qed
next
  fix Q'' b y u
  assume Eq: "a«x»  Q' = b<y>  Q''"
  assume yFreshP: "y  P"
  
  from Eq have "a = InputS b" by(simp add: residual.inject)
  from DerInput[OF this] obtain P'' where L1: "u. P'. P lu in P''b<x>  P' 
                                                        (P', Q'[x::=u])  Rel"
    by blast
  have "u. P'. P lu in ([(x, y)]  P'')b<y>  P'  (P', Q''[y::=u])  Rel"
  proof(rule allI)
    fix u
    from L1 Eq show "P'. P lu in ([(x, y)]  P'')b<y>  P'  (P', Q''[y::=u])  Rel"
    proof(cases "x=y", auto simp add: residual.inject name_abs_eq)
      assume Der: "u. P'. P lu in P''b<x>  P'  (P', ([(x, y)]  Q'')[x::=u])  Rel"
      assume xFreshQ'': "x  Q''"
      
      from Der obtain P' where PTrans: "P lu in P''b<x>  P'"
                          and P'RelQ': "(P', ([(x, y)]  Q'')[x::=u])  Rel"
        by force
      
      from PTrans yFreshP have "P lu in ([(x, y)]  P'')b<y>  P'" by(rule alphaInput)
      moreover from xFreshQ'' P'RelQ' have "(P', Q''[y::=u])  Rel"
        by(simp add: renaming)
      ultimately show ?thesis by force
    qed
  qed
  thus  "P''. u. P'. P lu in P''b<y>  P'  (P', Q''[y::=u])  Rel"
    by blast
qed

lemma simActFreeCases[consumes 0, case_names Der]:
  fixes P   :: pi
  and   α   :: freeRes
  and   Q'  :: pi
  and   Rel :: "(pi × pi) set"

  assumes "P'. (P l^α  P')  (P', Q')  Rel"

  shows "weakSimAct P (α  Q') P Rel"
using assms
by(simp add: residual.inject weakSimAct_def fresh_prod)

lemma simE:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   u   :: name
  and   Q'  :: pi

  assumes "P ^<Rel> Q"

  shows "Q ax>  Q'  x  P  P'. P l^ax>  P'  (P', Q')  Rel"
  and   "Q a<x>  Q'  x  P  P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel"
  and   "Q α  Q'  (P'. P l^α  P'  (P', Q')  Rel)"
using assms by(simp add: simDef)+

lemma weakSimTauChain:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   Q'  :: pi

  assumes QChain: "Q τ Q'"
  and     PRelQ: "(P, Q)  Rel"
  and     Sim: "P Q. (P, Q)  Rel  P ^<Rel> Q"

  shows "P'. P τ P'  (P', Q')  Rel"
proof -
  from QChain show ?thesis
  proof(induct rule: tauChainInduct)
    case id
    have "P τ P" by simp
    with PRelQ show ?case by blast
  next
    case(ih Q' Q'')
    have IH: "P'. P τ P'  (P', Q')  Rel" by fact
    then obtain P' where PChain: "P τ P'" and P'RelQ': "(P', Q')  Rel" by blast
    from P'RelQ' have "P' ^<Rel> Q'" by(rule Sim)
    moreover have Q'Trans: "Q' τ  Q''" by fact
    ultimately have "P''. P' l^τ  P''  (P'', Q'')  Rel" by(rule simE)
    then obtain P'' where P'Trans: "P' l^τ  P''" and P''RelQ'': "(P'', Q'')  Rel" by blast
    from P'Trans have "P' τ P''" by(rule tauTransitionChain)
    with PChain have "P τ P''" by auto
    with P''RelQ'' show ?case by blast
  qed
qed

lemma simE2:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   Q'  :: pi

  assumes PSimQ: "P ^<Rel> Q"
  and     Sim: "P Q. (P, Q)  Rel  P ^<Rel> Q"
  and     Eqvt: "eqvt Rel"
  and     PRelQ: "(P, Q)  Rel"

  shows "Q l^ax>  Q'  x  P  P'. P l^ax>  P'  (P', Q')  Rel"
  and   "Q l^α  Q'  P'. P l^α  P'  (P', Q')  Rel"
proof -
  assume QTrans: "Q l^ax>  Q'"
  assume xFreshP: "x  P"
  have Goal: "P Q a x Q'. P ^<Rel> Q; Q l^ax>  Q'; x  P; x  Q; (P, Q)  Rel 
                            P'. P l^ax>  P'  (P', Q')  Rel"
  proof -
    fix P Q a x Q'
    assume PSimQ: "P ^<Rel> Q"
    assume QTrans: "Q l^ax>  Q'"
    assume xFreshP: "x  P"
    assume xFreshQ: "x  Q"
    assume PRelQ: "(P, Q)  Rel"

    from QTrans xFreshQ obtain Q'' Q''' where QChain: "Q τ Q''"
                                          and Q''Trans: "Q'' ax>  Q'''"
                                          and Q'''Chain: "Q''' τ Q'"
      by(force dest: Weak_Late_Step_Semantics.transitionE simp add: weakTransition_def)

    from QChain PRelQ Sim have "P''. P τ P''  (P'', Q'')  Rel"
      by(rule weakSimTauChain)
    then obtain P'' where PChain: "P τ P''" and P''RelQ'': "(P'', Q'')  Rel" by blast
    from PChain xFreshP have xFreshP'': "x  P''" by(rule freshChain)

    from P''RelQ'' have "P'' ^<Rel> Q''" by(rule Sim)
    hence "P'''. P'' l^ax>  P'''  (P''', Q''')  Rel" using Q''Trans xFreshP''
      by(rule simE)
    then obtain P''' where P''Trans: "P'' l^ax>  P'''" and P'''RelQ''': "(P''', Q''')  Rel"
      by blast

    from P'''RelQ''' have "P''' ^<Rel> Q'''" by(rule Sim)
    have "P'. P''' τ P'  (P', Q')  Rel" using Q'''Chain P'''RelQ''' Sim
      by(rule weakSimTauChain)
    then obtain P' where P'''Chain: "P''' τ P'" and P'RelQ': "(P', Q')  Rel" by blast

    from PChain P''Trans P'''Chain xFreshP'' have "P l^ax>  P'"
      by(blast dest: chainTransitionAppend)
    with P'RelQ' show "P'. P l^ ax>  P'  (P', Q')  Rel" by blast
  qed

  have "c::name. c  (Q, Q', P, x)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshQ: "c  Q" and cFreshQ': "c  Q'" and cFreshP: "c  P"
                        and xineqc: "x  c"
    by(force simp add: fresh_prod)

  from QTrans cFreshQ' have "Q l^ac>  ([(x, c)]  Q')" by(simp add: alphaBoundResidual)
  with PSimQ have "P'. P l^ac>  P'  (P', [(x, c)]  Q')  Rel" using cFreshP cFreshQ (P, Q)  Rel
    by(rule Goal)
  then obtain P' where PTrans: "P l^ac>  P'" and P'RelQ': "(P', [(x, c)]  Q')  Rel"
    by force
  have "P l^ax>  ([(x, c)]  P')"
  proof -
    from PTrans xFreshP xineqc have "x  P'" by(rule freshTransition)
    with PTrans show ?thesis by(simp add: alphaBoundResidual name_swap)
  qed
  moreover have "([(x, c)]  P', Q')  Rel"
  proof -
    from Eqvt P'RelQ' have "([(x, c)]  P', [(x, c)]  [(x, c)]  Q')  Rel"
      by(rule eqvtRelI)
    thus ?thesis by simp
  qed

  ultimately show "P'. P l^ ax>  P'  (P', Q')  Rel" by blast
next
  assume QTrans: "Q l^α  Q'"
  thus "P'. P l^α  P'  (P', Q')  Rel"
  proof(induct rule: transitionCases)
    case Step
    have "Q lα  Q'" by fact
    then obtain Q'' Q''' where QChain: "Q τ Q''" 
                           and Q''Trans: "Q'' α  Q'''"
                           and Q'''Chain: "Q''' τ Q'"  
      by(blast dest: Weak_Late_Step_Semantics.transitionE)
    
    from QChain PRelQ Sim have "P''. P τ P''  (P'', Q'')  Rel"
      by(rule weakSimTauChain)
    then obtain P'' where PChain: "P τ P''" and P''RelQ'': "(P'', Q'')  Rel" by blast
    from P''RelQ'' have "P'' ^<Rel> Q''" by(rule Sim)
    hence "P'''. P'' l^α  P'''  (P''', Q''')  Rel" using Q''Trans
      by(rule simE)
    then obtain P''' where P''Trans: "P'' l^α  P'''" and P'''RelQ''': "(P''', Q''')  Rel"
      by blast
    
    from P'''RelQ''' have "P''' ^<Rel> Q'''" by(rule Sim)
    have "P'. P''' τ P'  (P', Q')  Rel" using Q'''Chain P'''RelQ''' Sim
      by(rule weakSimTauChain)
    then obtain P' where P'''Chain: "P''' τ P'" and P'RelQ': "(P', Q')  Rel" by blast
    
    from PChain P''Trans P'''Chain have "P l^α  P'"
      by(blast dest: chainTransitionAppend)
    with P'RelQ' show ?case by blast
  next
    case Stay
    have "α  Q' = τ  Q" by fact
    hence "Q = Q'" and "α = τ" by(simp add: residual.inject)+
    moreover have "P l^τ  P" by(simp add: weakTransition_def)
    ultimately show ?case using PRelQ by blast
  qed
qed
(*
lemma tauChainStep:
  fixes P  :: pi
  and   P' :: pi
  
  assumes PChain: "P ⟹τ P'"
  and     PineqP': "P ≠ P'"

  shows "∃P''. P ⟼τ ≺ P'' ∧ P'' ⟹τ P'"
proof -
  from PChain have "(P, P') ∈ Id ∪ (tauActs O tauActs* )"
    by(insert rtrancl_unfold, blast)
  with PineqP' have "(P, P') ∈ tauActs O tauActs*" by simp
  hence "(P, P') ∈ tauActs* O tauActs" by(simp add: r_comp_rtrancl_eq)
  thus ?thesis
    by(auto simp add: tauActs_def tauChain_def)
qed
*)
lemma eqvtI:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   perm :: "name prm"

  assumes Sim: "P ^<Rel> Q"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel': "eqvt Rel'"

  shows "(perm  P) ^<Rel'> (perm  Q)"
proof -
  from EqvtRel' show ?thesis
  proof(induct rule: simCasesCont[of _ "(perm  P)"])
    case(Bound Q' a x)
    have Trans: "(perm  Q)  ax>  Q'" and xFreshP: "x  perm  P" by fact+

    from Trans have "(rev perm  (perm  Q))  rev perm  (ax>  Q')"
      by(rule eqvts)
    hence "Q  (rev perm  a)(rev perm  x)>  (rev perm  Q')" 
      by(simp add: name_rev_per)
    moreover from xFreshP have "(rev perm  x)  P" by(simp add: name_fresh_left)
    ultimately have "P'. P l^ (rev perm  a)(rev perm  x)>  P'  (P', rev perm  Q')  Rel" using Sim
      by(force intro: simE)
    then obtain P' where PTrans: "P l^ (rev perm  a)(rev perm  x)>  P'" and P'RelQ': "(P', rev perm  Q')  Rel" by blast

    from PTrans have "(perm  P) l^ perm  ((rev perm  a)(rev perm  x)>  P')"
      by(rule Weak_Late_Semantics.eqvtI)
    hence L1: "(perm  P) l^ ax>  (perm  P')" by(simp add: name_per_rev)
    from P'RelQ' RelRel' have "(P', rev perm  Q')  Rel'" by blast
    with EqvtRel' have "(perm  P', perm  (rev perm  Q'))  Rel'"
      by(rule eqvtRelI)
    hence "(perm  P', Q')  Rel'" by(simp add: name_per_rev)
    with L1 show ?case by blast
  next
    case(Input Q' a x)
    have Trans: "(perm  Q) a<x>  Q'" and xFreshP: "x  perm  P" by fact+

    from Trans have "(rev perm  (perm  Q))  rev perm  (a<x>  Q')"
      by(rule eqvts)
    hence "Q  (rev perm  a)<(rev perm  x)>  (rev perm  Q')" 
      by(simp add: name_rev_per)
    moreover from xFreshP have xFreshP: "(rev perm  x)  P" by(simp add: name_fresh_left)
    ultimately have "P''. u. P'. P lu in P''(rev perm  a)<(rev perm  x)>  P'  (P', (rev perm  Q')[(rev perm  x)::=u])  Rel" using Sim
      by(force intro: simE)
    then obtain P'' where L1:  "u. P'. P lu in P''(rev perm  a)<(rev perm  x)>  P'  (P', (rev perm  Q')[(rev perm  x)::=u])  Rel"
      by blast
    have "u. P'. (perm  P) lu in (perm  P'')a<x>  P'  (P', Q'[x::=u])  Rel'"
    proof(rule allI)
      fix u
      from L1 obtain P' where PTrans: "P l(rev perm  u) in P''(rev perm  a)<(rev perm  x)>  P'"
                          and P'RelQ': "(P', (rev perm  Q')[(rev perm  x)::=(rev perm  u)])  Rel" by blast      
      from PTrans have "(perm  P) l(perm  (rev perm  u)) in (perm  P'')(perm  rev perm  a)<(perm  rev perm  x)>  (perm  P')"
        by(rule_tac Weak_Late_Step_Semantics.eqvtI, auto)
      hence L2: "(perm  P) lu in (perm  P'')a<x>  (perm  P')" by(simp add: name_per_rev)
      from P'RelQ' RelRel' have "(P', (rev perm  Q')[(rev perm  x)::=(rev perm  u)])  Rel'" by blast
      with EqvtRel' have "(perm  P', perm  ((rev perm  Q')[(rev perm  x)::=(rev perm  u)]))  Rel'"
        by(rule eqvtRelI)
      hence "(perm  P', Q'[x::=u])  Rel'" by(simp add: name_per_rev eqvt_subs[THEN sym] name_calc)
      with L2 show "P'. (perm  P) lu in (perm  P'')a<x>  P'  (P', Q'[x::=u])  Rel'" by blast
    qed

    thus ?case by blast
  next
    case(Free Q' α)
    have Trans: "(perm  Q)  α  Q'" by fact

    from Trans have "(rev perm  (perm  Q))  rev perm  (α  Q')"
      by(rule eqvts)
    hence "Q  (rev perm  α)  (rev perm  Q')" 
      by(simp add: name_rev_per)
    with Sim have "(P'. P l^ (rev perm  α)  P'  (P', (rev perm  Q'))  Rel)"
      by(rule simE)
    then obtain P' where PTrans: "P l^ (rev perm  α)  P'" and PRel: "(P', (rev perm  Q'))  Rel" by blast
    from PTrans have "(perm  P) l^ perm  ((rev perm  α) P')"
      by(rule Weak_Late_Semantics.eqvtI)
    hence L1: "(perm  P) l^ α  (perm  P')" by(simp add: name_per_rev)
    from PRel EqvtRel' RelRel'  have "((perm  P'), (perm  (rev perm  Q')))  Rel'"
      by(force intro: eqvtRelI)
    hence "((perm  P'), Q')  Rel'" by(simp add: name_per_rev)
    with L1 show ?case by blast
  qed 
qed

(*****************Reflexivity and transitivity*********************)

lemma reflexive:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "P ^<Rel> P"
using assms
by(auto intro: Weak_Late_Step_Semantics.singleActionChain
  simp add: simDef weakTransition_def)

lemma transitive:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"

  assumes QSimR: "Q ^<Rel'> R"
  and     Eqvt:  "eqvt Rel"
  and     Eqvt': "eqvt Rel''"
  and     Trans: "Rel O Rel'  Rel''"
  and     Sim:   "P Q. (P, Q)  Rel  P ^<Rel> Q"
  and     PRelQ: "(P, Q)  Rel"

  shows "P ^<Rel''> R"
proof -
  from PRelQ have PSimQ: "P ^<Rel> Q" by(rule Sim)
  from Eqvt' show ?thesis
  proof(induct rule: simCasesCont[of _ "(P, Q)"])
    case(Bound R' a x)
    have RTrans: "R  ax>  R'" by fact
    have "x  (P, Q)" by fact
    hence xFreshP: "x  P" and xFreshQ: "x  Q" by(simp add: fresh_prod)+

    from QSimR RTrans xFreshQ have "Q'. Q l^ax>  Q'  (Q', R')  Rel'"
      by(rule simE)
    then obtain Q' where QTrans: "Q l^ax>  Q'" and Q'RelR': "(Q', R')  Rel'" by blast
    from PSimQ Sim Eqvt PRelQ QTrans xFreshP have "P'. P l^ax>  P'  (P', Q')  Rel"
      by(rule simE2)
    then obtain P' where PTrans: "P l^ax>  P'" and P'RelQ': "(P', Q')  Rel" by blast
    moreover from P'RelQ' Q'RelR' Trans have "(P', R')  Rel''" by blast
    ultimately show ?case by blast
  next
    case(Input R' a x)
    have RTrans: "R  a<x>  R'" by fact
    have "x  (P, Q)" by fact
    hence xFreshP: "x  P" and xFreshQ: "x  Q" by(simp add: fresh_prod)+

    from QSimR RTrans xFreshQ  obtain Q'' where "u. Q'. Q lu in Q''a<x>  Q'  (Q', R'[x::=u])  Rel'" 
      by(blast dest: simE)
    hence "Q'''. Q τ Q'''  Q'''a<x>  Q''  (u. Q'. Q''[x::=u]τ Q'  (Q', R'[x::=u])  Rel')"
      by(simp add: inputTransition_def, blast)
    then obtain Q''' where QChain: "Q τ Q'''"
                       and Q'''Trans: "Q''' a<x>  Q''"
                       and L1: "u. Q'. Q''[x::=u]τ Q'  (Q', R'[x::=u])  Rel'"
      by blast
    from QChain PRelQ Sim have "P'''. P τ P'''  (P''', Q''')  Rel"
      by(rule weakSimTauChain)
    then obtain P''' where PChain: "P τ P'''" and P'''RelQ''': "(P''', Q''')  Rel" by blast
    from PChain xFreshP have xFreshP''': "x  P'''" by(rule freshChain)
    from P'''RelQ''' have "P''' ^<Rel> Q'''" by(rule Sim)
    hence "P''''. u. P''. P''' lu in P''''a<x>  P''  (P'', Q''[x::=u])  Rel" using Q'''Trans xFreshP'''
      by(rule simE)
    then obtain P'''' where L2: "u. P''. P''' lu in P''''a<x>  P''  (P'', Q''[x::=u])  Rel" 
      by blast
    have "u. P' Q'. P lu in P''''a<x>  P'  (P', R'[x::=u])  Rel''"
    proof(rule allI)
      fix u
      from L1 obtain Q' where Q''Chain: "Q''[x::=u] τ Q'" and Q'RelR': "(Q', R'[x::=u])  Rel'"
        by blast
      from L2 obtain P'' where P'''Trans: "P''' lu in P''''a<x>  P''"
                           and P''RelQ'': "(P'', Q''[x::=u])  Rel"
        by blast
      from P''RelQ'' have "P'' ^<Rel> Q''[x::=u]" by(rule Sim)
      have "P'. P'' τ P'  (P', Q')  Rel" using Q''Chain P''RelQ'' Sim
        by(rule weakSimTauChain)
      then obtain P' where P''Chain: "P'' τ P'" and P'RelQ': "(P', Q')  Rel" by blast
      from PChain P'''Trans P''Chain  have "P lu in P''''a<x>  P'"
        by(blast dest: Weak_Late_Step_Semantics.chainTransitionAppend)
      moreover from P'RelQ' Q'RelR' have "(P', R'[x::=u])  Rel''" by(insert Trans, auto)
      ultimately show "P' Q'. P lu in P''''a<x>  P'  (P', R'[x::=u])  Rel''" by blast
    qed
    thus ?case by force
  next
    case(Free R' α)
    have RTrans: "R  α  R'" by fact
    with QSimR have "Q'. Q l^α  Q'  (Q', R')  Rel'" by(rule simE)
    then obtain Q' where QTrans: "Q l^α  Q'" and Q'RelR': "(Q', R')  Rel'" by blast
    from PSimQ Sim Eqvt PRelQ QTrans have "P'. P l^α  P'  (P', Q')  Rel" by(rule simE2)
    then obtain P' where PTrans: "P l^α  P'" and P'RelQ': "(P', Q')  Rel" by blast
    from P'RelQ' Q'RelR' Trans have "(P', R')  Rel''" by blast
    with PTrans show "P'. P l^α  P'  (P', R')  Rel''" by blast
  qed
qed

lemma strongSimWeakSim:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"

  shows "P ^<Rel> Q"
proof(induct rule: simCases)
  case(Bound Q' a x)
  have "Q ax>  Q'" and "x  P" by fact+
  with PSimQ obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel"
    by(force dest: Strong_Late_Sim.simE simp add: derivative_def)

  from PTrans have "P l^ax>  P'"
    by(force intro: Weak_Late_Step_Semantics.singleActionChain simp add: weakTransition_def)
  with P'RelQ' show ?case by blast
next
  case(Input Q' a x)
  assume "Q a<x>  Q'" and "x  P"
  with PSimQ obtain P' where PTrans: "P a<x>  P'" and PDer: "derivative P' Q' (InputS a) x Rel"
    by(blast dest: Strong_Late_Sim.simE)

  have "u. P''. P lu in P'a<x>  P''  (P'', Q'[x::=u])  Rel"
  proof(rule allI)
    fix u
    from PTrans have "P lu in P'a<x>  P'[x::=u]" by(blast intro: Weak_Late_Step_Semantics.singleActionChain)
    moreover from PDer have "(P'[x::=u], Q'[x::=u])  Rel" by(force simp add: derivative_def)
    ultimately show "P''. P lu in P'a<x>  P''  (P'', Q'[x::=u])  Rel" by auto
  qed
  thus ?case by blast
next
  case(Free Q' α)
  have "Q α  Q'" by fact
  with PSimQ obtain P' where PTrans: "P α  P'" and P'RelQ': "(P', Q')  Rel"
    by(blast dest: Strong_Late_Sim.simE)
  from PTrans have "P l^α  P'" by(rule Weak_Late_Semantics.singleActionChain)
  with P'RelQ' show ?case by blast
qed

lemma strongAppend:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"

  assumes PSimQ: "P ^<Rel> Q"
  and     QSimR: "Q ↝[Rel'] R"
  and     Eqvt'': "eqvt Rel''"
  and     Trans: "Rel O Rel'  Rel''"

  shows "P ^<Rel''> R"
proof -
  from Eqvt'' show ?thesis
  proof(induct rule: simCasesCont[of _ "(P, Q)"])
    case(Bound R' a x)
    have "x  (P, Q)" by fact
    hence xFreshP: "x  P" and xFreshQ: "x  Q" by(simp add: fresh_prod)+
    have RTrans: "R ax>  R'" by fact
    from xFreshQ QSimR RTrans obtain Q' where QTrans: "Q ax>  Q'"
                                          and Q'Rel'R': "(Q', R')  Rel'"
      by(force dest: Strong_Late_Sim.simE simp add: derivative_def)

    with PSimQ QTrans xFreshP have "P'. P l^ ax>  P'  (P', Q')  Rel"
      by(blast intro: simE)
    then obtain P' where PTrans: "P l^ ax>  P'" and P'RelQ': "(P', Q')  Rel" by blast
    moreover from P'RelQ' Q'Rel'R' Trans have "(P', R')  Rel''" by blast
    ultimately show ?case by blast
  next
    case(Input R' a x)
    have RTrans: "R  a<x>  R'" by fact
    have "x  (P, Q)" by fact
    hence xFreshP: "x  P" and xFreshQ: "x  Q" by(simp add: fresh_prod)+

    from QSimR RTrans xFreshQ  obtain Q' where QTrans: "Q a<x>  Q'" and Q'Der: "derivative Q' R' (InputS a) x Rel'"
      by(blast dest: Strong_Late_Sim.simE)
    from QTrans PSimQ xFreshP obtain P'' where L2: "u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel" 
      by(blast dest: simE)
    have "u. P'. P lu in P''a<x>  P'  (P', R'[x::=u])  Rel''"
    proof(rule allI)
      fix u
      from L2 obtain P' where PTrans: "P lu in P''a<x>  P'"
                          and P'RelQ': "(P', Q'[x::=u])  Rel"
        by blast
      moreover from Q'Der have "(Q'[x::=u], R'[x::=u])  Rel'" by(simp add: derivative_def)
      ultimately show "P'. P lu in P''a<x>  P'  (P', R'[x::=u])  Rel''" using Trans by blast
    qed
    thus ?case by force
  next
    case(Free R' α)
    have RTrans: "R  α  R'" by fact
    with QSimR obtain Q' where QTrans: "Q α  Q'" and Q'RelR': "(Q', R')  Rel'"
      by(blast dest: Strong_Late_Sim.simE)
    from PSimQ QTrans have "P'. P l^ α  P'  (P', Q')  Rel"
      by(blast intro: simE)
    then obtain P' where PTrans: "P l^ α  P'" and P'RelQ': "(P', Q')  Rel" by blast
    from P'RelQ' Q'RelR' Trans have "(P', R')  Rel''" by blast
    with PTrans show ?case by blast
  qed
qed

end

Theory Weak_Late_Bisim

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Bisim
  imports Weak_Late_Sim Strong_Late_Bisim
begin

lemma monoAux: "A  B  P ^<A> Q  P ^<B> Q"
by(auto intro: Weak_Late_Sim.monotonic)

coinductive_set weakBisim :: "(pi × pi) set"
where
  step: "P ^<weakBisim> Q; (Q, P)  weakBisim  (P, Q)  weakBisim"
monos monoAux

abbreviation
  "weakBisimJudge" (infixr "" 65)  where "P  Q  (P, Q)  weakBisim"

lemma weakBisimCoinductAux[case_names weakBisim, case_conclusion weakBisim step, consumes 1]:
  assumes p: "(P, Q)  X"
  and step:  "P Q. (P, Q)  X  P ^<(X  weakBisim)> Q  ((Q, P)  X  Q  P)"

  shows "P  Q"
proof -
  have aux: "X  weakBisim = {(P, Q). (P, Q)  X  P  Q}" by blast

  from p show ?thesis
    by(coinduct, force dest: step simp add: aux)
qed

lemma weakBisimCoinduct[consumes 1, case_names cSim cSym]:
  fixes P :: pi
  and   Q :: pi

  assumes "(P, Q)  X"
  and     "P Q. (P, Q)  X  P ^<(X  weakBisim)> Q"
  and     "P Q. (P, Q)  X  (Q, P)  X"

  shows "P  Q"
using assms
by(coinduct rule: weakBisimCoinductAux) auto

lemma weak_coinduct[case_names weakBisim, case_conclusion weakBisim step, consumes 1]:
  assumes p: "(P, Q)  X"
  and step:  "P Q. (P, Q)  X  P ^<X> Q  (Q, P)  X"

  shows "P  Q"
using p
proof(coinduct rule: weakBisimCoinductAux)
  case (weakBisim P Q)
  from step[OF this] show ?case using Weak_Late_Sim.monotonic by blast
qed

lemma weakBisimWeakCoinduct[consumes 1, case_names cSim cSym]:
  fixes P :: pi
  and   Q :: pi

  assumes "(P, Q)  X"
  and     "P Q. (P, Q)  X  P ^<X> Q"
  and     "P Q. (P, Q)  X  (Q, P)  X"

  shows "P  Q"
using assms
by(coinduct rule: weak_coinduct) auto
lemma monotonic: "mono(λp x1 x2. P Q. x1 = P  x2 = Q  P ^<{(xa, x). p xa x}> Q  Q ^<{(xa, x). p xa x}> P)"
by(auto intro: monoI Weak_Late_Sim.monotonic)

lemma unfoldE:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"
  
  shows "P ^<weakBisim> Q"
  and   "Q  P"
using assms
by(auto intro: weakBisim.cases)

lemma unfoldI:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P ^<weakBisim> Q"
  and     "Q  P"

  shows "P  Q"
using assms
by(auto intro: weakBisim.cases)

lemma eqvt:
  shows "eqvt weakBisim"
proof(auto simp add: eqvt_def)
  let ?X = "{x. P Q (perm::name prm). P  Q  x = (perm  P, perm  Q)}"
  fix P Q
  fix perm::"name prm"
  assume PBiSimQ: "P  Q"

  hence "(perm  P, perm  Q)  ?X" by blast
  moreover have "P Q perm::name prm. P ^<weakBisim> Q  (perm  P) ^<?X> (perm  Q)"
  proof -
    fix P Q
    fix perm::"name prm"
    assume "P ^<weakBisim> Q"

    moreover have "weakBisim  ?X"
    proof(auto)
      fix P Q
      assume "P  Q"
      moreover have "P = ([]::name prm)  P" and "Q = ([]::name prm)  Q" by auto
      ultimately show "P' Q'. P'  Q'  ((perm::name prm). P = perm  P'  Q = perm  Q')"
        by blast
    qed

    moreover have "eqvt ?X"
    proof(auto simp add: eqvt_def)
      fix P Q
      fix perm1::"name prm"
      fix perm2::"name prm"

      assume "P  Q"
      moreover have "perm1  perm2  P = (perm1 @ perm2)  P" by(simp add: pt2[OF pt_name_inst])
      moreover have "perm1  perm2  Q = (perm1 @ perm2)  Q" by(simp add: pt2[OF pt_name_inst])

      ultimately show "P' Q'. P'  Q'  ((perm::name prm). perm1  perm2  P = perm  P' 
                                                              perm1  perm2  Q = perm  Q')"
        by blast
    qed

    ultimately show "(perm  P) ^<?X> (perm  Q)"
      by(rule Weak_Late_Sim.eqvtI)
    qed

    ultimately show "(perm  P)  (perm  Q)" by(coinduct rule: weak_coinduct, blast dest: unfoldE)
qed

lemma eqvtI:
  fixes P :: pi
  and   Q :: pi
  and   perm :: "name prm"

  assumes "P  Q"

  shows "(perm  P)  (perm  Q)"
using assms
by(rule eqvtRelI[OF eqvt])

lemma weakBisimEqvt[simp]:
  shows "eqvt weakBisim"
by(auto simp add: eqvt_def eqvtI)

lemma strongBisimWeakBisim:
  fixes P :: pi
  and   Q :: pi

  assumes PSimQ: "P  Q"

  shows "P  Q"
proof -
  have "P Q. P ↝[bisim] Q  P ^<(bisim  weakBisim)> Q"
  proof -
    fix P Q
    assume "P ↝[bisim] Q"
    hence "P ^<bisim> Q" by(rule strongSimWeakSim)
    thus "P ^<(bisim  weakBisim)> Q"
      by(blast intro: Weak_Late_Sim.monotonic)
  qed

  with PSimQ show ?thesis
    by(coinduct rule: weakBisimCoinductAux, force dest: Strong_Late_Bisim.bisimE symmetric)
qed

lemma reflexive:
  fixes P :: pi

  shows "P  P"
proof -
  have "(P, P)  Id" by simp
  then show ?thesis

  proof (coinduct rule: weak_coinduct)
    case (weakBisim P Q)
    have "(P, Q)  Id" by fact
    thus ?case by(auto intro: Weak_Late_Sim.reflexive)
  qed
qed

lemma symmetric:
  fixes P :: pi
  and   Q :: pi
   
  assumes "P  Q"

  shows "Q  P"
using assms
by(auto dest: unfoldE intro: unfoldI)

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes PBiSimQ: "P  Q"
  and     QBiSimR: "Q  R"

  shows "P  R"
proof -
  let ?X = "weakBisim O weakBisim"
  from assms have "(P, R)  ?X" by blast
  moreover have "P Q R. Q ^<weakBisim> R; P  Q 
                          P ^<(?X  weakBisim)> R"
  proof -
    fix P Q R
    assume PBiSimQ: "P  Q"
    assume "Q ^<weakBisim> R"
    moreover have "eqvt weakBisim" by(rule eqvt)
    moreover from eqvt have "eqvt (?X  weakBisim)" by(auto simp add: eqvtTrans)
    moreover have "weakBisim O weakBisim  ?X  weakBisim" by auto
    moreover have "P Q. P  Q  P ^<weakBisim> Q" by(rule unfoldE)

    ultimately show "P ^<(?X  weakBisim)> R" using PBiSimQ
      by(rule Weak_Late_Sim.transitive)
  qed

  ultimately show ?thesis
    apply(coinduct rule: weakBisimCoinduct, auto)
    by(blast dest: unfoldE symmetric)+
qed


lemma transitive_coinduct_weak[case_names WeakBisimEarly, case_conclusion WeakBisimEarly step, consumes 2]:
  assumes p: "(P, Q)  X"
  and Eqvt: "eqvt X"
  and step: "P Q. (P, Q)  X  P ^<(bisim O X O bisim)> Q  (Q, P)  X"

  shows "P  Q"
proof -
  let ?X = "bisim O X O bisim"

  have Sim: "P P' Q' Q. P  P'; P'^<?X> Q'; Q' ↝[bisim] Q 
                          P ^<?X> Q"
  proof -
    fix P P' Q' Q
    assume PBisimP': "P  P'"
    assume P'SimQ': "P' ^<?X> Q'"
    assume Q'SimQ: "Q' ↝[bisim] Q"

    show "P ^<?X> Q"
    proof -
      have "P' ^<?X> Q"
      proof -
        have "?X O bisim  ?X" by(blast intro: Strong_Late_Bisim.transitive)
        moreover from Strong_Late_Bisim.bisimEqvt Eqvt have "eqvt ?X" by blast
        ultimately show ?thesis using P'SimQ' Q'SimQ by(blast intro: strongAppend)
      qed
      moreover have "eqvt bisim" by(rule Strong_Late_Bisim.bisimEqvt)
      moreover from Strong_Late_Bisim.bisimEqvt Eqvt have "eqvt ?X" by blast
      moreover have "bisim O ?X  ?X" by(blast intro: Strong_Late_Bisim.transitive)
      moreover have "P Q. P  Q  P ^<bisim> Q" by(blast dest: Strong_Late_Bisim.bisimE strongSimWeakSim)
      ultimately show ?thesis using PBisimP' by(rule Weak_Late_Sim.transitive)
    qed
  qed

  from p have "(P, Q)  ?X" by(blast intro: Strong_Late_Bisim.reflexive)
  moreover from step Sim have "P Q. (P, Q)  ?X  P ^<?X> Q  (Q, P)  ?X"
    by(blast dest: Strong_Late_Bisim.bisimE Strong_Late_Bisim.symmetric)

  ultimately show ?thesis by(rule weak_coinduct)
qed

lemma weakBisimTransitiveCoinduct[case_names cSim cSym, consumes 2]:
  assumes p: "(P, Q)  X"
  and Eqvt: "eqvt X"
  and rSim: "P Q. (P, Q)  X  P ^<(bisim O X O bisim)> Q"
  and rSym: "P Q. (P, Q)  X  (Q, P)  X"

  shows "P  Q"
using assms
by(coinduct rule: transitive_coinduct_weak) auto

end

Theory Weak_Late_Step_Sim

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Step_Sim
  imports Weak_Late_Step_Semantics Weak_Late_Sim Strong_Late_Sim
begin

definition weakStepSimAct :: "pi  residual  ('a::fs_name)  (pi × pi) set  bool" where
  "weakStepSimAct P Rs C Rel  (Q' a x. Rs = ax>  Q'  x  C  (P' . P lax>  P'  (P', Q')  Rel)) 
                           (Q' a x. Rs = a<x>  Q'  x  C  (P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel)) 
                           (Q' α. Rs = α  Q'  (P'. P lα  P'  (P', Q')  Rel))"

definition weakStepSimAux :: "pi  (pi × pi) set  pi  bool" where
  "weakStepSimAux P Rel Q  (Q' a x. (Q ax>  Q'  x  P)  (P' . P lax>  P'  (P', Q')  Rel)) 
                           (Q' a x. (Q a<x>  Q'   x  P)  (P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel)) 
                           (Q' α. Q α  Q'  (P'. P lα  P'  (P', Q')  Rel))"

definition weakStepSim :: "pi  (pi × pi) set  pi  bool" ("_ ↝<_> _" [80, 80, 80] 80) where
  "P ↝<Rel> Q  (Rs. Q  Rs  weakStepSimAct P Rs P Rel)"

lemmas weakStepSimDef = weakStepSimAct_def weakStepSim_def
lemma "weakStepSimAux P Rel Q = weakStepSim P Rel Q"
by(auto simp add: weakStepSimDef weakStepSimAux_def)

lemma monotonic:
  fixes A  :: "(pi × pi) set"
  and   B  :: "(pi × pi) set"
  and   P  :: pi
  and   P' :: pi

  assumes "P ↝<A> P'"
  and     "A  B"

  shows "P ↝<B> P'"
using assms
apply(auto simp add: weakStepSimDef)
apply blast
apply(erule_tac x="a<x>  Q'" in allE)
apply(clarsimp)
apply(rotate_tac 4)
apply(erule_tac x=Q' in allE)
apply(erule_tac x=a in allE)
apply(erule_tac x=x in allE)
by blast+

lemma simCasesCont[consumes 1, case_names Bound Input Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   C   :: "'a::fs_name"

  assumes Eqvt:  "eqvt Rel"
  and     Bound: "Q' a x. x  C; Q ax>  Q'  P'. P lax>  P'  (P', Q')  Rel"
  and     Input: "Q' a x. x  C; Q a<x>  Q'  P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel"
  and     Free:  "Q' α. Q  α  Q'  (P'. P l α  P'  (P', Q')  Rel)"

  shows "P ↝<Rel> Q"
using Free
proof(auto simp add: weakStepSimDef)
  fix Q' a x
  assume xFreshP: "(x::name)  P"
  assume Trans: "Q  ax>  Q'"
  have "c::name. c  (P, Q', x, C)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshQ': "c  Q'" and cFreshC: "c  C"
                        and cineqx: "c  x"
    by(force simp add: fresh_prod)

  from Trans cFreshQ' have "Q  ac>  ([(x, c)]  Q')" by(simp add: alphaBoundResidual)
  with cFreshC have "P'. P l ac>  P'  (P', [(x, c)]  Q')  Rel"
    by(rule Bound)
  then obtain P' where PTrans: "P l ac>  P'" and P'RelQ': "(P', [(x, c)]  Q')  Rel"
    by blast

  from PTrans xFreshP cineqx have xFreshP': "x  P'" by(force dest: Weak_Late_Step_Semantics.freshTransition)
  with PTrans have "P l ax>  ([(x, c)]  P')" by(simp add: alphaBoundResidual name_swap)
  moreover have "([(x, c)]  P', Q')  Rel" (is "?goal")
  proof -
    from Eqvt P'RelQ' have "([(x, c)]  P', [(x, c)]  [(x, c)]  Q')  Rel"
      by(rule eqvtRelI)
    with cineqx show ?goal by(simp add: name_calc)
  qed
  ultimately show "P'. P lax>  P'  (P', Q')  Rel" by blast
next
  fix Q' a x u
  assume QTrans: "Q a<x>  (Q'::pi)"
     and xFreshP: "x  P"

  have "c::name. c  (P, Q', C, x)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshQ': "c  Q'" and cFreshC: "c  C"
                        and cineqx: "c  x"
    by(force simp add: fresh_prod)

  from QTrans cFreshQ' have "Q a<c>  ([(x, c)]  Q')" by(simp add: alphaBoundResidual)
  with cFreshC have "P''. u. P'. P lu in P''a<c>  P'  (P', ([(x, c)]  Q')[c::=u])  Rel"
    by(rule Input)
  
  then obtain P'' where L1: "u. P'. P lu in P''a<c>  P'  (P', ([(x, c)]  Q')[c::=u])  Rel" by blast
  
  have "u. P'. P lu in ([(c, x)]  P'')a<x>  P'  (P', Q'[x::=u])  Rel"
  proof(auto)
    fix u
    from L1 obtain P' where PTrans: "P lu in P''a<c>  P'" and P'RelQ': "(P', ([(x, c)]  Q')[c::=u])  Rel"
      by blast
    
    from PTrans xFreshP have "P lu in ([(c, x)]  P'')a<x>  P'" by(rule alphaInput) 
    moreover from P'RelQ' cFreshQ' have "(P', Q'[x::=u])  Rel" by(simp add: renaming[THEN sym] name_swap)
    
    ultimately show "P'. P lu in ([(c, x)]  P'')a<x>  P'  (P', Q'[x::=u])  Rel" by blast
  qed
  
  thus "P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel" by blast
qed

lemma simCases[consumes 0, case_names Bound Input Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   C   :: "'a::fs_name"

  assumes Bound: "Q' a x. Q ax>  Q'; x  P  P'. P lax>  P'  (P', Q')  Rel"
  and     Input: "Q' a x. Q a<x>  Q'; x  P  P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel"
  and     Free:  "Q' α. Q  α  Q'  (P'. P l α  P'  (P', Q')  Rel)"

  shows "P ↝<Rel> Q"
using assms
by(auto simp add: weakStepSimDef)

lemma simActBoundCases[consumes 1, case_names Input BoundOutput]:
  fixes P   :: pi
  and   a   :: subject
  and   x   :: name
  and   Q'  :: pi
  and   C   :: "'a::fs_name"
  and   Rel :: "(pi × pi) set"

  assumes EqvtRel: "eqvt Rel"
  and     DerInput: "b. a = InputS b  (P''. u. P'. (P lu in P''b<x>  P')  (P', Q'[x::=u])  Rel)"
  and     DerBoundOutput: "b. a = BoundOutputS b  (P'. (P lbx>  P')  (P', Q')  Rel)"

  shows "weakStepSimAct P (a«x»  Q') P Rel"
proof(simp add: weakStepSimAct_def fresh_prod, auto)
  fix Q'' b y
  assume Eq: "a«x»  Q' = by>  Q''"
  assume yFreshP: "y  P"

  from Eq have "a = BoundOutputS b" by(simp add: residual.inject)

  from yFreshP DerBoundOutput[OF this] Eq show "P'. P lby>  P'  (P', Q'')  Rel"
  proof(cases "x=y", auto simp add: residual.inject name_abs_eq)
    fix P'
    assume PTrans: "P lbx>  P'"
    assume P'RelQ': "(P', ([(x, y)]  Q''))  Rel"
    assume xineqy: "x  y"

    with PTrans yFreshP have yFreshP': "y  P'"
      by(force intro: Weak_Late_Step_Semantics.freshTransition)

    hence "bx>  P' = by>  [(x, y)]  P'" by(rule alphaBoundResidual)
    moreover have "([(x, y)]  P', Q'')  Rel"
    proof -
      from EqvtRel P'RelQ' have "([(x, y)]  P', [(x, y)]  ([(x, y)]  Q'')) Rel"
        by(rule eqvtRelI)
      thus ?thesis by(simp add: name_calc)
    qed

    ultimately show "P'. P lby>  P'  (P', Q'')  Rel" using PTrans by auto
  qed
next
  fix Q'' b y u
  assume Eq: "a«x»  Q' = b<y>  Q''"
  assume yFreshP: "y  P"
  
  from Eq have "a = InputS b" by(simp add: residual.inject)
  from DerInput[OF this] obtain P'' where L1: "u. P'. P lu in P''b<x>  P' 
                                                        (P', Q'[x::=u])  Rel"
    by blast
  have "u. P'. P lu in ([(x, y)]  P'')b<y>  P'  (P', Q''[y::=u])  Rel"
  proof(rule allI)
    fix u
    from L1 Eq show "P'. P lu in ([(x, y)]  P'')b<y>  P'  (P', Q''[y::=u])  Rel"
    proof(cases "x=y", auto simp add: residual.inject name_abs_eq)
      assume Der: "u. P'. P lu in P''b<x>  P'  (P', ([(x, y)]  Q'')[x::=u])  Rel"
      assume xFreshQ'': "x  Q''"
      
      
      from Der obtain P' where PTrans: "P lu in P''b<x>  P'"
                          and P'RelQ': "(P', ([(x, y)]  Q'')[x::=u])  Rel"
        by force
      
      from PTrans yFreshP have "P lu in ([(x, y)]  P'')b<y>  P'" by(rule alphaInput)
      moreover from xFreshQ'' P'RelQ' have "(P', Q''[y::=u])  Rel"
        by(simp add: renaming)
      ultimately show ?thesis by force
    qed
  qed
  thus  "P''. u. P'. P lu in P''b<y>  P'  (P', Q''[y::=u])  Rel"
    by blast
qed

lemma simActFreeCases[consumes 0, case_names Free]:
  fixes P   :: pi
  and   α   :: freeRes
  and   C   :: "'a::fs_name"
  and   Rel :: "(pi × pi) set"

  assumes Der: "P'. (P lα  P')  (P', Q')  Rel"

  shows "weakStepSimAct P (α  Q') P Rel"
using assms
by(simp add: weakStepSimAct_def residual.inject)

lemma simE:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   u   :: name
  and   Q'  :: pi

  assumes "P ↝<Rel> Q"

  shows "Q ax>  Q'  x  P  P'. P lax>  P'  (P', Q')  Rel"
  and   "Q a<x>  Q'  x  P  P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel"
  and   "Q α  Q'  (P'. P lα  P'  (P', Q')  Rel)"
using assms by(simp add: weakStepSimDef)+

lemma weakSimTauChain:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   Q'  :: pi

  assumes QChain: "Q τ Q'"
  and     PRelQ: "(P, Q)  Rel"
  and     Sim: "P Q. (P, Q)  Rel  P ↝<Rel> Q"

  shows "P'. P τ P'  (P', Q')  Rel"
proof -
  from QChain show ?thesis
  proof(induct rule: tauChainInduct)
    case id
    have "P τ P" by simp
    with PRelQ show ?case by blast
  next
    case(ih Q' Q'')
    have IH: "P'. P τ P'  (P', Q')  Rel" by fact
    then obtain P' where PChain: "P τ P'" and P'RelQ': "(P', Q')  Rel" by blast
    from P'RelQ' have "P' ↝<Rel> Q'" by(rule Sim)
    moreover have Q'Trans: "Q' τ  Q''" by fact
    ultimately have "P''. P' lτ  P''  (P'', Q'')  Rel" by(rule simE)
    then obtain P'' where P'Trans: "P' lτ  P''" and P''RelQ'': "(P'', Q'')  Rel" by blast
    from P'Trans have "P' τ P''" by(rule Weak_Late_Step_Semantics.tauTransitionChain)
    with PChain have "P τ P''" by auto
    with P''RelQ'' show ?case by blast
  qed
qed

lemma strongSimWeakEqSim:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"

  shows "P ↝<Rel> Q"
proof(auto simp add: weakStepSimDef)
  fix Q' a x
  assume "Q ax>  Q'" and "x  P"
  with PSimQ have "P'. P ax>  P'  derivative P' Q' (BoundOutputS a) x Rel"
    by(rule Strong_Late_Sim.simE)
  then obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel"
    by(force simp add: derivative_def)

  from PTrans have "P lax>  P'" by(rule Weak_Late_Step_Semantics.singleActionChain)
  thus "P'. P lax>  P'  (P', Q')  Rel" using P'RelQ' by blast
next
  fix Q' a x u
  assume "Q a<x>  Q'" and "x  P"
  with PSimQ have L1: "P'. P a<x>  P'  derivative P' Q' (InputS a) x Rel"
    by(blast intro: Strong_Late_Sim.simE)
  then obtain P' where PTrans: "P a<x>  P'" and PDer: "derivative P' Q' (InputS a) x Rel"
    by blast

  have "u. P''. P lu in P'a<x>  P''  (P'', Q'[x::=u])  Rel"
  proof(rule allI)
    fix u
    from PTrans have "P lu in P'a<x>  P'[x::=u]" by(blast intro: Weak_Late_Step_Semantics.singleActionChain)
    moreover from PDer have "(P'[x::=u], Q'[x::=u])  Rel" by(force simp add: derivative_def)
    ultimately show "P''. P lu in P'a<x>  P''  (P'', Q'[x::=u])  Rel" by auto
  qed
  thus "P''. u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel" by blast
next
  fix Q' α
  assume "Q α  Q'"
  with PSimQ have "P'. P α  P'  (P', Q')  Rel" by(rule Strong_Late_Sim.simE)
  then obtain P' where PTrans: "P α  P'" and P'RelQ': "(P', Q')  Rel" by blast

  from PTrans have "P lα  P'" by(rule Weak_Late_Step_Semantics.singleActionChain)
  thus "P'. P lα  P'  (P', Q')  Rel" using P'RelQ' by blast
qed

lemma weakSimWeakEqSim:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"

  assumes "P ↝<Rel> Q"

  shows "P ^<Rel> Q"
using assms
by(force simp add: weakStepSimDef simDef weakTransition_def)

lemma eqvtI:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   perm :: "name prm"

  assumes Sim: "P ↝<Rel> Q"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel': "eqvt Rel'"

  shows "(perm  P) ↝<Rel'> (perm  Q)"
using EqvtRel'
proof(induct rule: simCasesCont[of _ "perm  P"])
  case(Bound Q' a x)
  have QTrans: "(perm  Q)  ax>  Q'" by fact
  have xFreshP: "x  perm  P" by fact

  from QTrans have "(rev perm  (perm  Q))  rev perm  (ax>  Q')"
    by(rule eqvts)
  hence "Q  (rev perm  a)(rev perm  x)>  (rev perm  Q')" 
    by(simp add: name_rev_per)
  moreover from xFreshP have "(rev perm  x)  P" by(simp add: name_fresh_left)
  ultimately obtain P' where PTrans: "P l (rev perm  a)(rev perm  x)>  P'"
                         and P'RelQ': "(P', rev perm  Q')  Rel" using Sim
    by(blast dest: simE)

  from PTrans have "(perm  P) l perm  ((rev perm  a)(rev perm  x)>  P')" 
    by(rule Weak_Late_Step_Semantics.eqvtI)
  hence "(perm  P) l ax>  (perm  P')" by(simp add: name_per_rev)
  moreover have "(perm  P', Q')  Rel'"
  proof -
    from P'RelQ' RelRel' have "(P', rev perm  Q')  Rel'" by blast
    with EqvtRel' have "(perm  P', perm  (rev perm  Q'))  Rel'"
      by(rule eqvtRelI)
    thus ?thesis by(simp add: name_per_rev)
  qed
  ultimately show ?case by blast
next
  case(Input Q' a x)
  have QTrans: "(perm  Q) a<x>  Q'" by fact
  have xFreshP: "x  perm  P" by fact

  from QTrans have "(rev perm  (perm  Q))  rev perm  (a<x>  Q')"
    by(rule eqvts)
  hence "Q  (rev perm  a)<(rev perm  x)>  (rev perm  Q')" 
    by(simp add: name_rev_per)
  moreover from xFreshP have xFreshP: "(rev perm  x)  P" by(simp add: name_fresh_left)
  ultimately obtain P'' 
    where L1:  "u. P'. P lu in P''(rev perm  a)<(rev perm  x)>  P'  
                         (P', (rev perm  Q')[(rev perm  x)::=u])  Rel" using Sim
    by(blast dest: simE)
  have "u. P'. (perm  P) lu in (perm  P'')a<x>  P'  (P', Q'[x::=u])  Rel'"
  proof(rule allI)
    fix u
    from L1 obtain P' where PTrans: "P l(rev perm  u) in P''(rev perm  a)<(rev perm  x)>  P'"
                        and P'RelQ': "(P', (rev perm  Q')[(rev perm  x)::=(rev perm  u)])  Rel" by blast      
    from PTrans have "(perm  P) l(perm  (rev perm  u)) in (perm  P'')(perm  rev perm  a)<(perm  rev perm  x)>  (perm  P')"
      by(rule_tac Weak_Late_Step_Semantics.eqvtI, auto)
    hence "(perm  P) lu in (perm  P'')a<x>  (perm  P')" by(simp add: name_per_rev)
    moreover have "(perm  P', Q'[x::=u])  Rel'"
    proof -
      from P'RelQ' RelRel' have "(P', (rev perm  Q')[(rev perm  x)::=(rev perm  u)])  Rel'" by blast
      with EqvtRel' have "(perm  P', perm  ((rev perm  Q')[(rev perm  x)::=(rev perm  u)]))  Rel'"
        by(rule eqvtRelI)
      thus ?thesis by(simp add: name_per_rev eqvt_subs[THEN sym] name_calc)
    qed
    ultimately show "P'. (perm  P) lu in (perm  P'')a<x>  P'  (P', Q'[x::=u])  Rel'" by blast
  qed
  thus ?case by blast
next
  case(Free Q' α)
  have QTrans: "(perm  Q)  α  Q'" by fact

  from QTrans have "(rev perm  (perm  Q))  rev perm  (α  Q')"
    by(rule eqvts)
  hence "Q  (rev perm  α)  (rev perm  Q')" 
    by(simp add: name_rev_per)
  with Sim obtain P' where PTrans: "P l (rev perm  α)  P'" and PRel: "(P', (rev perm  Q'))  Rel" 
    by(blast dest: simE)
  from PTrans have "(perm  P) l perm  ((rev perm  α) P')"
    by(rule Weak_Late_Step_Semantics.eqvtI)
  hence "(perm  P) l α  (perm  P')" by(simp add: name_per_rev)
  moreover have "((perm  P'), Q')  Rel'"
  proof -
    from PRel EqvtRel' RelRel'  have "((perm  P'), (perm  (rev perm  Q')))  Rel'"
      by(force intro: eqvtRelI)
    thus ?thesis by(simp add: name_per_rev)
  qed
  ultimately show ?case by blast
qed

lemma simE2:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   Q'  :: pi

  assumes PSimQ: "P ↝<Rel> Q"
  and     Sim: "P Q. (P, Q)  Rel  P ^<Rel> Q"
  and     Eqvt: "eqvt Rel"
  and     PRelQ: "(P, Q)  Rel"

  shows "Q lax>  Q'  x  P  P'. P lax>  P'  (P', Q')  Rel"
  and   "Q lα  Q'  P'. P lα  P'  (P', Q')  Rel"
proof -
  assume QTrans: "Q lax>  Q'"
  assume xFreshP: "x  P"
  have Goal: "P Q a x Q'. P ↝<Rel> Q; Q lax>  Q'; x  P; x  Q; (P, Q)  Rel 
                            P'. P lax>  P'  (P', Q')  Rel"
  proof -
    fix P Q a x Q'
    assume PSimQ: "P ↝<Rel> Q"
    assume QTrans: "Q lax>  Q'"
    assume xFreshP: "x  P"
    assume xFreshQ: "x  Q"
    assume PRelQ: "(P, Q)  Rel"

    from QTrans xFreshQ obtain Q'' Q''' where QChain: "Q τ Q''"
                                          and Q''Trans: "Q'' ax>  Q'''"
                                          and Q'''Chain: "Q''' τ Q'"
      by(force dest: transitionE simp add: weakTransition_def)

    from QChain PRelQ Sim have "P''. P τ P''  (P'', Q'')  Rel"
      by(rule Weak_Late_Sim.weakSimTauChain)
    then obtain P'' where PChain: "P τ P''" and P''RelQ'': "(P'', Q'')  Rel" by blast
    from PChain xFreshP have xFreshP'': "x  P''" by(rule freshChain)

    from P''RelQ'' have "P'' ^<Rel> Q''" by(rule Sim)
    hence "P'''. P'' l^ax>  P'''  (P''', Q''')  Rel" using Q''Trans xFreshP''
      by(rule Weak_Late_Sim.simE)
    then obtain P''' where P''Trans: "P'' lax>  P'''" and P'''RelQ''': "(P''', Q''')  Rel"
      by(force simp add: weakTransition_def)

    have "P'. P''' τ P'  (P', Q')  Rel" using Q'''Chain P'''RelQ''' Sim
      by(rule Weak_Late_Sim.weakSimTauChain)
    then obtain P' where P'''Chain: "P''' τ P'" and P'RelQ': "(P', Q')  Rel" by blast

    from PChain P''Trans P'''Chain xFreshP'' have "P lax>  P'"
      by(blast dest: Weak_Late_Step_Semantics.chainTransitionAppend)
    with P'RelQ' show "P'. P l ax>  P'  (P', Q')  Rel" by blast
  qed

  have "c::name. c  (Q, Q', P, x)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshQ: "c  Q" and cFreshQ': "c  Q'" and cFreshP: "c  P"
                        and xineqc: "x  c"
    by(force simp add: fresh_prod)

  from QTrans cFreshQ' have "Q lac>  ([(x, c)]  Q')" by(simp add: alphaBoundResidual)
  with PSimQ have "P'. P lac>  P'  (P', [(x, c)]  Q')  Rel" using cFreshP cFreshQ PRelQ
    by(rule Goal)
  then obtain P' where PTrans: "P lac>  P'" and P'RelQ': "(P', [(x, c)]  Q')  Rel"
    by force
  have "P lax>  ([(x, c)]  P')"
  proof -
    from PTrans xFreshP xineqc have "x  P'" by(rule Weak_Late_Step_Semantics.freshTransition)
    with PTrans show ?thesis by(simp add: alphaBoundResidual name_swap)
  qed
  moreover have "([(x, c)]  P', Q')  Rel"
  proof -
    from Eqvt P'RelQ' have "([(x, c)]  P', [(x, c)]  [(x, c)]  Q')  Rel"
      by(rule eqvtRelI)
    thus ?thesis by simp
  qed

  ultimately show "P'. P l ax>  P'  (P', Q')  Rel" by blast
next
  assume QTrans: "Q lα  Q'"

  then obtain Q'' Q''' where QChain: "Q τ Q''" 
                       and Q''Trans: "Q'' α  Q'''"
                       and Q'''Chain: "Q''' τ Q'"
    by(blast dest: transitionE)
  
  thus "P'. P l α  P'  (P', Q')  Rel"
  proof(induct arbitrary: α Q''' Q' rule: tauChainInduct)
    case(id α Q''')
    from PSimQ Q α  Q''' have "P'. P lα  P'  (P', Q''')  Rel"
      by(blast dest: simE)
    then obtain P''' where PTrans: "P lα  P'''" and P'RelQ''': "(P''', Q''')  Rel"
      by blast
    
    have "P'. P''' τ P'  (P', Q')  Rel" using Q''' τ Q' P'RelQ''' Sim
      by(rule Weak_Late_Sim.weakSimTauChain)
    then obtain P' where P'''Chain: "P''' τ P'" and P'RelQ': "(P', Q')  Rel" by blast
    
    from P'''Chain PTrans have "P lα  P'"
      by(blast dest: Weak_Late_Step_Semantics.chainTransitionAppend)
    
    with P'RelQ' show ?case by blast
  next
    case(ih Q'''' Q''' α Q'' Q')
    have "Q''' τ Q'''" by simp
    with Q'''' τ  Q''' obtain P''' where PTrans: "P lτ  P'''" and P'''RelQ''': "(P''', Q''')  Rel"
      by(drule_tac ih) auto
    from P'''RelQ''' Q''' α  Q'' obtain P'' where 
      P'''Trans: "P''' l^α  P''" and P''RelQ'': "(P'', Q'')  Rel"
      by(blast dest: Weak_Late_Sim.simE Sim)
    from P''RelQ'' Q'' τ Q' Sim obtain P' where 
      P''Chain: "P'' τ P'" and P'RelQ': "(P', Q') Rel"
      by(drule_tac Weak_Late_Sim.weakSimTauChain) auto
    
    from PTrans P'''Trans P''Chain have "P lα  P'"
      apply(auto simp add: weakTransition_def residual.inject)
      apply(drule_tac Weak_Late_Step_Semantics.tauTransitionChain, auto)
      apply(drule_tac Weak_Late_Step_Semantics.chainTransitionAppend, simp)
      apply(rule Weak_Late_Step_Semantics.chainTransitionAppend, auto)
      by(drule_tac Weak_Late_Step_Semantics.chainTransitionAppend, auto)
    with (P', Q')  Rel show ?case by blast
  qed
qed

(*****************Reflexivity and transitivity*********************)

lemma reflexive:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "P ↝<Rel> P"
using assms
by(auto intro: Weak_Late_Step_Semantics.singleActionChain simp add: weakStepSimDef)

lemma transitive:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"

  assumes PSimQ: "P ↝<Rel> Q"
  and     QSimR: "Q ↝<Rel'> R"
  and     Eqvt:  "eqvt Rel"
  and     Eqvt': "eqvt Rel''"
  and     Trans: "Rel O Rel'  Rel''"
  and     Sim:   "P Q. (P, Q)  Rel  P ^<Rel> Q"
  and     PRelQ: "(P, Q)  Rel"

  shows "P ↝<Rel''> R"
using Eqvt'
proof(induct rule: simCasesCont[of _ "(P, Q)"])
  case(Bound R' a x)
  have RTrans: "R  ax>  R'" by fact
  have "x  (P, Q)" by fact
  hence xFreshP: "x  P" and xFreshQ: "x  Q" by(simp add: fresh_prod)+
  
  from QSimR RTrans xFreshQ obtain Q' where QTrans: "Q lax>  Q'"
                                        and Q'RelR': "(Q', R')  Rel'"
    by(blast dest: simE)
  from PSimQ Sim Eqvt PRelQ QTrans xFreshP obtain P' where PTrans: "P lax>  P'"
                                                       and P'RelQ': "(P', Q')  Rel"
    by(blast dest: simE2)
  moreover from P'RelQ' Q'RelR' Trans have "(P', R')  Rel''" by blast
  ultimately show ?case by blast
next
  case(Input R' a x)
  have RTrans: "R  a<x>  R'" by fact
  have "x  (P, Q)" by fact
  hence xFreshP: "x  P" and xFreshQ: "x  Q" by(simp add: fresh_prod)+

  from QSimR RTrans xFreshQ obtain Q''
    where "u. Q'. Q lu in Q''a<x>  Q'  (Q', R'[x::=u])  Rel'" 
    by(blast dest: simE)
  hence "Q'''. Q τ Q'''  Q'''a<x>  Q''  (u. Q'. Q''[x::=u]τ Q'  (Q', R'[x::=u])  Rel')"
    by(simp add: inputTransition_def, blast)
  then obtain Q''' where QChain: "Q τ Q'''"
                     and Q'''Trans: "Q''' a<x>  Q''"
                     and L1: "u. Q'. Q''[x::=u]τ Q'  (Q', R'[x::=u])  Rel'"
    by blast
  from QChain PRelQ Sim obtain P''' where PChain: "P τ P'''" and P'''RelQ''': "(P''', Q''')  Rel" 
    by(drule_tac Weak_Late_Sim.weakSimTauChain) auto
  from PChain xFreshP have xFreshP''': "x  P'''" by(rule freshChain)
  from P'''RelQ''' have "P''' ^<Rel> Q'''" by(rule Sim)
  with xFreshP''' Q'''Trans obtain P'''' where L2: "u. P''. P''' lu in P''''a<x>  P''  (P'', Q''[x::=u])  Rel" 
    by(blast dest: Weak_Late_Sim.simE)
  have "u. P' Q'. P lu in P''''a<x>  P'  (P', R'[x::=u])  Rel''"
  proof(rule allI)
    fix u
    from L1 obtain Q' where Q''Chain: "Q''[x::=u] τ Q'" and Q'RelR': "(Q', R'[x::=u])  Rel'"
      by blast
    from L2 obtain P'' where P'''Trans: "P''' lu in P''''a<x>  P''"
                         and P''RelQ'': "(P'', Q''[x::=u])  Rel"
      by blast
    from P''RelQ'' have "P'' ^<Rel> Q''[x::=u]" by(rule Sim)
    have "P'. P'' τ P'  (P', Q')  Rel" using Q''Chain P''RelQ'' Sim
      by(rule Weak_Late_Sim.weakSimTauChain)
    then obtain P' where P''Chain: "P'' τ P'" and P'RelQ': "(P', Q')  Rel" by blast
    from PChain P'''Trans P''Chain  have "P lu in P''''a<x>  P'"
      by(blast dest: Weak_Late_Step_Semantics.chainTransitionAppend)
    moreover from P'RelQ' Q'RelR' have "(P', R'[x::=u])  Rel''" by(insert Trans, auto)
    ultimately show "P' Q'. P lu in P''''a<x>  P'  (P', R'[x::=u])  Rel''" by blast
  qed
  thus ?case by force
next
  case(Free R' α)
  have RTrans: "R  α  R'" by fact
  with QSimR obtain Q' where QTrans: "Q lα  Q'" and Q'RelR': "(Q', R')  Rel'"
    by(blast dest: simE)
  from PSimQ Sim Eqvt PRelQ QTrans obtain P' where PTrans: "P lα  P'"
                                               and P'RelQ': "(P', Q')  Rel"
    by(blast dest: simE2)
  from P'RelQ' Q'RelR' Trans have "(P', R')  Rel''" by blast
  with PTrans show ?case by blast
qed

end

Theory Weak_Late_Cong

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Cong
  imports Weak_Late_Bisim Weak_Late_Step_Sim Strong_Late_Bisim
begin

definition congruence :: "(pi × pi) set" where 
  "congruence  {(P, Q) |P Q. P ↝<weakBisim> Q  Q ↝<weakBisim> P}"
abbreviation congruenceJudge (infixr "" 65) where "P  Q  (P, Q)  congruence"

lemma unfoldE:
  fixes P :: pi
  and   Q :: pi
  and   s :: "(name × name) list"

  assumes "P  Q"

  shows "P ↝<weakBisim> Q"
  and   "Q ↝<weakBisim> P"
proof -
  from assms show "P ↝<weakBisim> Q" by(force simp add: congruence_def)
next
  from assms show "Q ↝<weakBisim> P" by(force simp add: congruence_def)
qed

lemma unfoldI:
  fixes P :: pi
  and   Q :: pi

  assumes "P ↝<weakBisim> Q"
  and     "Q ↝<weakBisim> P"

  shows "P  Q"
using assms by(force simp add: congruence_def)


lemma eqvt:
  shows "eqvt congruence"
proof -
  have "P Q (perm::name prm). P ↝<weakBisim> Q  (perm  P) ↝<weakBisim> (perm  Q)"
  proof -
    fix P Q perm
    assume "P ↝<weakBisim> Q"
    thus "((perm::name prm)  P) ↝<weakBisim> (perm  Q)"
      apply -
      by(blast intro: Weak_Late_Step_Sim.eqvtI Weak_Late_Bisim.eqvt)
  qed
  thus ?thesis
    by(simp add: congruence_def eqvt_def)
qed

lemma eqvtI:
  fixes P :: pi
  and   Q :: pi
  and   perm :: "name prm"

  assumes "P  Q"

  shows "(perm  P)  (perm  Q)"
using assms
by(rule eqvtRelI[OF eqvt])

lemma strongBisimWeakEq:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"

  shows "P  Q"
proof -
  have "P Q. P ↝[bisim] Q  P ↝<weakBisim> Q"
  proof -
    fix P Q
    assume "P ↝[bisim] Q"
    hence "P ↝<bisim> Q" by(rule strongSimWeakEqSim)
    moreover have "bisim  weakBisim"
      by(auto intro: strongBisimWeakBisim)
    ultimately show "P ↝<weakBisim> Q" by(rule Weak_Late_Step_Sim.monotonic)
  qed
  with assms show ?thesis
    by(blast intro: unfoldI dest: Strong_Late_Bisim.bisimE Strong_Late_Bisim.symmetric)
qed

lemma congruenceWeakBisim:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"

  shows "P  Q"
proof -
  let ?X = "{(P, Q) | P Q. P  Q}"
  from assms have "(P, Q)  ?X" by auto
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim P Q)
    {
      fix P Q
      assume "P  Q"
      hence "P ↝<weakBisim> Q" by(simp add: congruence_def)
      hence "P ↝<(?X  weakBisim)> Q" by(rule_tac Weak_Late_Step_Sim.monotonic) auto
      hence "P ^<(?X  weakBisim)> Q" by(rule Weak_Late_Step_Sim.weakSimWeakEqSim)
    }
    with (P, Q)  ?X show ?case by auto
  next
    case(cSym P Q)
    thus ?case by(auto simp add: congruence_def)
  qed 
qed

lemma congruenceSubsetWeakBisim:
  shows "congruence  weakBisim"
by(auto intro: congruenceWeakBisim)

lemma reflexive:
  fixes P :: pi
  
  shows "P  P"
proof -
  from Weak_Late_Bisim.reflexive have "P. P ↝<weakBisim> P"
    by(blast intro: Weak_Late_Step_Sim.reflexive)
  thus ?thesis
    by(force simp add: substClosed_def congruence_def)
qed

lemma symetric:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P  Q"
  
  shows "Q  P"
using assms
by(force simp add: substClosed_def congruence_def)

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  assumes "P  Q"
  and     "Q  R"
  
  shows "P  R"
proof -
  have Goal: "P Q R. P ↝<weakBisim> Q; Q ↝<weakBisim> R; P  Q  P ↝<weakBisim> R"
    using Weak_Late_Bisim.eqvt Weak_Late_Bisim.unfoldE Weak_Late_Bisim.transitive
    by(blast intro: Weak_Late_Step_Sim.transitive)
  from assms show ?thesis
    apply(simp add: congruence_def) using assms
    by(blast intro: Goal dest: congruenceWeakBisim symetric)
qed

end

Theory Weak_Late_Bisim_Subst

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Bisim_Subst
  imports Weak_Late_Bisim Strong_Late_Bisim_Subst
begin

consts weakBisimSubst :: "(pi × pi) set"
abbreviation
  weakBisimSubstJudge (infixr "s" 65) where "P s Q  (P, Q)  (substClosed weakBisim)"

lemma congBisim:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"

  shows "P  Q"
proof -
  from assms substClosedSubset show ?thesis
    by blast
qed

lemma strongBisimWeakBisim:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "P s Q"
using assms
by(auto simp add: substClosed_def intro: strongBisimWeakBisim)

lemma eqvt:
  shows "eqvt (substClosed weakBisim)"
by(rule eqvtSubstClosed[OF Weak_Late_Bisim.eqvt])

lemma eqvtI:
  fixes P :: pi
  and   Q :: pi
  and   perm :: "name prm"

  assumes "P s Q"

  shows "(perm  P) s (perm  Q)"
using assms
by(rule_tac eqvtRelI[OF eqvt])

lemma reflexive:
  fixes P :: pi
  
  shows "P s P"
by(force simp add: substClosed_def intro: Weak_Late_Bisim.reflexive)

lemma symetric:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"
  
  shows "Q s P"
using assms
by(force simp add: substClosed_def intro: Weak_Late_Bisim.symmetric)

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  assumes "P s Q"
  and     "Q s R"
  
  shows "P s R"
using assms
by(force simp add: substClosed_def intro: Weak_Late_Bisim.transitive)


lemma partUnfold:
  fixes P :: pi
  and   Q :: pi
  and   s :: "(name × name) list"

  assumes "P s Q"

  shows "P[<s>] s Q[<s>]"
using assms
proof(auto simp add: substClosed_def)
  fix s'
  assume "s. P[<s>]  Q[<s>]"
  hence "P[<(s@s')>]  Q[<(s@s')>]" by blast
  moreover have "P[<(s@s')>] = (P[<s>])[<s'>]"
    by(induct s', auto)
  moreover have "Q[<(s@s')>] = (Q[<s>])[<s'>]"
    by(induct s', auto)
  
  ultimately show "(P[<s>])[<s'>]  (Q[<s>])[<s'>]"
    by simp
qed
  
end

Theory Weak_Late_Cong_Subst

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Cong_Subst
  imports Weak_Late_Cong Weak_Late_Bisim_Subst Strong_Late_Bisim_Subst
begin

definition congruenceSubst :: "pi  pi bool" (infixr "s" 65) where
  "P s Q  (P, Q)  (substClosed congruence)"

lemmas congruenceSubstDef = congruenceSubst_def congruence_def substClosed_def

lemma unfoldE:
  fixes P :: pi
  and   Q :: pi
  and   s :: "(name × name) list"

  assumes "P s Q"

  shows "P[<s>] ↝<weakBisim> Q[<s>]"
  and   "Q[<s>] ↝<weakBisim> P[<s>]"
proof -
  from assms show "P[<s>] ↝<weakBisim> Q[<s>]" by(force simp add: congruenceSubstDef)
next
  from assms show "Q[<s>] ↝<weakBisim> P[<s>]" by(force simp add: congruenceSubstDef)
qed

lemma unfoldI:
  fixes P :: pi
  and   Q :: pi

  assumes "s. P[<s>] ↝<weakBisim> Q[<s>]  Q[<s>] ↝<weakBisim> P[<s>]"

  shows "P s Q"
proof -
  from assms show ?thesis by(force simp add: congruenceSubstDef)
qed

lemma weakEqSubset:
  shows "substClosed congruence  weakBisim"
proof(auto simp add: substClosed_def)
  fix P Q
  assume "s. P[<s>]  Q[<s>]"
  hence "P[<[]>]  Q[<[]>]" by blast
  thus "P  Q"
    by(force dest: congruenceWeakBisim intro: Weak_Late_Bisim.unfoldI)
qed


lemma weakCongWeakEq:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"

  shows "P  Q"
using assms
apply(auto simp add: substClosed_def congruenceSubst_def)
apply(erule_tac x="[]" in allE)
by auto

lemma eqvt:
  shows "eqvt (substClosed congruence)"
by(rule eqvtSubstClosed[OF Weak_Late_Cong.eqvt])

lemma eqvtI:
  fixes P :: pi
  and   Q :: pi
  and   perm :: "name prm"

  assumes "P s Q"

  shows "(perm  P) s (perm  Q)"
using assms
by(simp add: congruenceSubst_def) (rule eqvtRelI[OF eqvt])

lemma strongEqWeakCong:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "P s Q"
using assms
by(force intro: strongBisimWeakEq simp add: substClosed_def congruenceSubst_def)

lemma congSubstBisimSubst:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "P s Q"
using assms
by(force simp add: congruenceSubst_def substClosed_def intro: congruenceWeakBisim)


lemma reflexive:
  fixes P :: pi
  
  shows "P s P"
proof -
  from Weak_Late_Bisim.reflexive have "P. P ↝<weakBisim> P"
    by(blast intro: Weak_Late_Step_Sim.reflexive)
  thus ?thesis
    by(force simp add: congruenceSubstDef)
qed

lemma symetric:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"
  
  shows "Q s P"
using assms
by(force simp add: congruenceSubstDef)

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  assumes "P s Q"
  and     "Q s R"
  
  shows "P s R"
using assms
by(force simp add: congruenceSubst_def substClosed_def intro: Weak_Late_Cong.transitive)

lemma partUnfold:
  fixes P :: pi
  and   Q :: pi
  and   s :: "(name × name) list"

  assumes "P s Q"

  shows "P[<s>] s Q[<s>]"
using assms
proof(auto simp add: congruenceSubst_def substClosed_def)
  fix s'
  assume "s. (P[<s>], Q[<s>])  congruence"
  hence "(P[<(s@s')>], Q[<(s@s')>])  congruence" by blast
  moreover have "P[<(s@s')>] = (P[<s>])[<s'>]"
    by(induct s', auto)
  moreover have "Q[<(s@s')>] = (Q[<s>])[<s'>]"
    by(induct s', auto)
  
  ultimately show "((P[<s>])[<s'>], (Q[<s>])[<s'>])  congruence"
    by simp
qed

end

Theory Strong_Late_Sim_SC

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Sim_SC
  imports Strong_Late_Sim
begin

(************** Zero **********************)

lemma nilSim[dest]:
  fixes a :: name
  and   b :: name
  and   x :: name
  and   P :: pi
  and   Q :: pi

  shows "𝟬 ↝[Rel] τ.(P)  False"
  and   "𝟬 ↝[Rel] a<x>.P  False"
  and   "𝟬 ↝[Rel] a{b}.P  False"
by(fastforce simp add: simulation_def intro: Tau Input Output)+

lemma nilSimRight:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  shows "P ↝[Rel] 𝟬"
by(auto simp add: simulation_def)

(************** Match *********************)

lemma matchIdLeft:
  fixes a   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "[aa]P ↝[Rel] P"
using assms
by(force simp add: simulation_def dest: Match derivativeReflexive)

lemma matchIdRight:
  fixes P   :: pi
  and   a   :: name
  and   Rel :: "(pi × pi) set"

  assumes IdRel: "Id  Rel"

  shows "P ↝[Rel] [aa]P"
using assms
by(fastforce simp add: simulation_def elim: matchCases intro: derivativeReflexive)

lemma matchNilLeft:
  fixes a :: name
  and   b :: name
  and   P :: pi

  assumes "a  b"
  
  shows "𝟬 ↝[Rel] [ab]P"
using assms
by(auto simp add: simulation_def)

(************** Mismatch *********************)

lemma mismatchIdLeft:
  fixes a   :: name
  and   b   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"
  and     "a  b"

  shows "[ab]P ↝[Rel] P"
using assms
by(fastforce simp add: simulation_def intro: Mismatch dest: derivativeReflexive)

lemma mismatchIdRight:
  fixes P   :: pi
  and   a   :: name
  and   b   :: name
  and   Rel :: "(pi × pi) set"

  assumes IdRel: "Id  Rel"
  and     aineqb: "a  b"

  shows "P ↝[Rel] [ab]P"
using assms
by(fastforce simp add: simulation_def elim: mismatchCases intro: derivativeReflexive)

lemma mismatchNilLeft:
  fixes a :: name
  and   P :: pi
  
  shows "𝟬 ↝[Rel] [aa]P"
by(auto simp add: simulation_def)

(************** +-operator *****************)

lemma sumSym:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"
  
  shows "P  Q ↝[Rel] Q  P"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: Sum1 Sum2 derivativeReflexive)

lemma sumIdempLeft:
  fixes P :: pi
  and Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "P ↝[Rel] P  P"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: derivativeReflexive)

lemma sumIdempRight:
  fixes P :: pi
  and Rel :: "(pi × pi) set"

  assumes I: "Id  Rel"

  shows "P  P ↝[Rel] P"
using assms
by(fastforce simp add: simulation_def intro: Sum1 derivativeReflexive)

lemma sumAssocLeft:
  fixes P   :: pi
  and   Q   :: pi
  and   R   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"

  shows "(P  Q)  R ↝[Rel] P  (Q  R)"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: Sum1 Sum2 derivativeReflexive)

lemma sumAssocRight:
  fixes P   :: pi
  and   Q   :: pi
  and   R   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"

  shows "P  (Q  R) ↝[Rel] (P  Q)  R"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: Sum1 Sum2 derivativeReflexive)

lemma sumZeroLeft:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"

  shows "P  𝟬 ↝[Rel] P"
using assms
by(fastforce simp add: simulation_def intro: Sum1 derivativeReflexive)

lemma sumZeroRight:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"

  shows "P ↝[Rel] P  𝟬"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: derivativeReflexive)

lemma sumResLeft:
  fixes x   :: name
  and   P   :: pi
  and   Q   :: pi

  assumes Id: "Id  Rel"
  and     Eqvt: "eqvt Rel"

  shows "(x>P)  (x>Q) ↝[Rel] x>(P  Q)"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
  case(Bound a y PQ)
  from y  (x, P, Q) have "y  x" and "y  P" and "y  Q" by(simp add: fresh_prod)+
  hence "y  P  Q" by simp
  with x>(P  Q) a«y»  PQ y  x show ?case
  proof(induct rule: resCasesB)
    case(cOpen a PQ)
    from P  Q a[x]  PQ y  P y  Q have "y  PQ" by(force dest: freshFreeDerivative)
    from P  Q a[x]  PQ show ?case
    proof(induct rule: sumCases)
      case cSum1
      from P a[x]  PQ a  x have "x>P ax>  PQ" by(rule Open)
      hence "(x>P)  (x>Q) ax>  PQ" by(rule Sum1)
      with y  PQ have "(x>P)  (x>Q) ay>  ([(y, x)]  PQ)" 
        by(simp add: alphaBoundResidual)
      moreover from Id have "derivative ([(y, x)]  PQ) ([(y, x)]  PQ) (BoundOutputS a) y Rel"
        by(force simp add: derivative_def)
      ultimately show ?case by blast
    next
      case cSum2
      from Q a[x]  PQ a  x have "x>Q ax>  PQ" by(rule Open)
      hence "(x>P)  (x>Q) ax>  PQ" by(rule Sum2)
      with y  PQ have "(x>P)  (x>Q) ay>  ([(y, x)]  PQ)" 
        by(simp add: alphaBoundResidual)
      moreover from Id have "derivative ([(y, x)]  PQ) ([(y, x)]  PQ) (BoundOutputS a) y Rel"
        by(force simp add: derivative_def)
      ultimately show ?case by blast
    qed
  next
    case(cRes PQ)
    from P  Q a«y»  PQ show ?case
    proof(induct rule: sumCases)
      case cSum1
      from P a«y»  PQ x  a y  x have "x>P a«y»  x>PQ" by(rule_tac ResB) auto
      hence "(x>P)  (x>Q) a«y»  x>PQ" by(rule Sum1)
      moreover from Id have "derivative (x>PQ) (x>PQ) a y Rel"
        by(cases a) (auto simp add: derivative_def)
      ultimately show ?case by blast
    next
      case cSum2
      from Q a«y»  PQ x  a y  x have "x>Q a«y»  x>PQ" by(rule_tac ResB) auto
      hence "(x>P)  (x>Q) a«y»  x>PQ" by(rule Sum2)
      moreover from Id have "derivative (x>PQ) (x>PQ) a y Rel"
        by(cases a) (auto simp add: derivative_def)
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α PQ)
  from x>(P  Q) α  PQ show ?case
  proof(induct rule: resCasesF)
    case(cRes PQ)
    from P  Q α  PQ show ?case
    proof(induct rule: sumCases)
      case cSum1 
      from P α  PQ x  α have "x>P α  x>PQ" by(rule ResF)
      hence "(x>P)  (x>Q) α  x>PQ" by(rule Sum1)
      with Id show ?case by blast
    next
      case cSum2
      from Q α  PQ x  α have "x>Q α  x>PQ" by(rule ResF)
      hence "(x>P)  (x>Q) α  x>PQ" by(rule Sum2)
      with Id show ?case by blast
    qed
  qed
qed

lemma sumResRight:
  fixes x   :: name
  and   P   :: pi
  and   Q   :: pi

  assumes Id: "Id  Rel"
  and     Eqvt: "eqvt Rel"

  shows "x>(P  Q) ↝[Rel] (x>P)  (x>Q)"
using ‹eqvt Rel
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
  case(Bound a y PQ)
  from y  (x, P, Q) have "y  x" and "y  P" and "y  Q" by(simp add: fresh_prod)+
  from (x>P)  (x>Q) a«y»  PQ show ?case
  proof(induct rule: sumCases)
    case cSum1
    from x>P a«y»  PQ show ?case using y  x y  P
    proof(induct rule: resCasesB)
      case(cOpen a P')
      from P a[x]  P' y  P have "y  P'" by(rule freshFreeDerivative)
      
      from P a[x]  P' have "P  Q a[x]  P'" by(rule Sum1)
      hence "x>(P  Q) ax>  P'" using a  x by(rule Open)
      with y  P' have "x>(P  Q) ay>  [(y, x)]  P'" by(simp add: alphaBoundResidual)
      moreover from Id have "derivative ([(y, x)]  P') ([(y, x)]  P') (BoundOutputS a) y Rel"
        by(force simp add: derivative_def)
      ultimately show ?case by blast
    next
      case(cRes P')
      from P a«y»  P' have "P  Q a«y»  P'" by(rule Sum1)
      hence "x>(P  Q) a«y»  x>P'" using x  a y  x by(rule_tac ResB) auto
      moreover from Id have "derivative (x>P') (x>P') a y Rel"
        by(cases a) (auto simp add: derivative_def)
      ultimately show ?case by blast
    qed
  next
    case cSum2
    from x>Q a«y»  PQ show ?case using y  x y  Q
    proof(induct rule: resCasesB)
      case(cOpen a Q')
      from Q a[x]  Q' y  Q have "y  Q'" by(rule freshFreeDerivative)
      
      from Q a[x]  Q' have "P  Q a[x]  Q'" by(rule Sum2)
      hence "x>(P  Q) ax>  Q'" using a  x by(rule Open)
      with y  Q' have "x>(P  Q) ay>  [(y, x)]  Q'" by(simp add: alphaBoundResidual)
      moreover from Id have "derivative ([(y, x)]  Q') ([(y, x)]  Q') (BoundOutputS a) y Rel"
        by(force simp add: derivative_def)
      ultimately show ?case by blast
    next
      case(cRes Q')
      from Q a«y»  Q' have "P  Q a«y»  Q'" by(rule Sum2)
      hence "x>(P  Q) a«y»  x>Q'" using x  a y  x by(rule_tac ResB) auto
      moreover from Id have "derivative (x>Q') (x>Q') a y Rel"
        by(cases a) (auto simp add: derivative_def)
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α PQ)
  from (x>P)  (x>Q) α  PQ show ?case
  proof(induct rule: sumCases)
    case cSum1
    from x>P α  PQ show ?case
    proof(induct rule: resCasesF)
      case(cRes P')
      from P α  P' have "P  Q α  P'" by(rule Sum1)
      hence "x>(P  Q) α  x>P'" using x  α by(rule ResF)
      with Id show ?case by blast
    qed
  next
    case cSum2
    from x>Q α  PQ show ?case
    proof(induct rule: resCasesF)
      case(cRes Q')
      from Q α  Q' have "P  Q α  Q'" by(rule Sum2)
      hence "x>(P  Q) α  x>Q'" using x  α by(rule ResF)
      with Id show ?case by blast
    qed
  qed
qed

(************** |-operator *************)

lemma parZeroLeft:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes ParZero: "Q. (Q  𝟬, Q)  Rel"

  shows "P  𝟬 ↝[Rel] P"
proof -
  {
    fix P Q a x
    from ParZero have "derivative (P  𝟬) P a x Rel"
      by(case_tac a) (auto simp add: derivative_def)
  }
  thus ?thesis using assms
    by(fastforce simp add: simulation_def intro: Par1B Par1F)
qed

lemma parZeroRight:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes ParZero: "Q. (Q, Q  𝟬)  Rel"

  shows "P ↝[Rel] P  𝟬"
proof -
  {
    fix P Q a x
    from ParZero have "derivative P (P  𝟬) a x Rel"
      by(case_tac a) (auto simp add: derivative_def)
  }
  thus ?thesis using assms
    by(fastforce simp add: simulation_def elim: parCasesF parCasesB)+
qed
  
lemma parSym:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  
  assumes Sym: "R S. (R  S, S  R)  Rel"
  and     Res: "R S x. (R, S)  Rel  (x>R, x>S)  Rel"
  
  shows "P  Q ↝[Rel] Q  P"
proof(induct rule: simCases)
  case(Bound a x QP)
  from x  (P  Q) have "x  Q" and "x  P" by simp+
  with Q  P  a«x»  QP show ?case
  proof(induct rule: parCasesB)
    case(cPar1 Q')
    from Q a«x»  Q' have "P  Q a«x»  P  Q'" using x  P by(rule Par2B)
    moreover have "derivative (P  Q')  (Q'  P) a x Rel"
      by(cases a, auto simp add: derivative_def intro: Sym)
    ultimately show ?case by blast
  next
    case(cPar2 P')
    from P a«x»  P' have "P  Q a«x»  P'  Q" using x  Q by(rule Par1B)
    moreover have "derivative (P'  Q)  (Q  P') a x Rel"
      by(cases a, auto simp add: derivative_def intro: Sym)
    ultimately show ?case by blast
  qed
next
  case(Free α QP)
  from Q  P  α  QP show ?case
  proof(induct rule: parCasesF[where C="()"])
    case(cPar1 Q')
    from Q  α  Q' have "P  Q  α  P  Q'" by(rule Par2F)
    moreover have "(P  Q', Q'  P)  Rel" by(rule Sym)
    ultimately show ?case by blast
  next
    case(cPar2 P')
    from P  α  P' have "P  Q  α  P'  Q" by(rule Par1F)
    moreover have "(P'  Q, Q  P')  Rel" by(rule Sym)
    ultimately show ?case by blast
  next
    case(cComm1 Q' P' a b x)
    from P a[b]  P' Q a<x>  Q'
    have "P  Q  τ  P'  (Q'[x::=b])" by(rule Comm2)
    moreover have "(P'  Q'[x::=b], Q'[x::=b]  P')  Rel" by(rule Sym)
    ultimately show ?case by blast
  next
    case(cComm2 Q' P' a b x)
    from P a<x>  P' Q a[b]  Q'
    have "P  Q  τ  (P'[x::=b])  Q'" by(rule Comm1)
    moreover have "(P'[x::=b]  Q', Q'  P'[x::=b])  Rel" by(rule Sym)
    ultimately show ?case by blast
  next
    case(cClose1 Q' P' a x y)
    from P  ay>  P' Q  a<x>  Q' y  Q
    have "P  Q  τ  y>(P'  (Q'[x::=y]))" by(rule Close2)
    moreover have "(y>(P'  Q'[x::=y]), y>(Q'[x::=y]  P'))  Rel" by(metis Res Sym)
    ultimately show ?case by blast
  next
    case(cClose2 Q' P' a x y)
    from P  a<x>  P' Q  ay>  Q' y  P
    have "P  Q  τ  y>((P'[x::=y])  Q')" by(rule Close1)
    moreover have "(y>(P'[x::=y]  Q'), y>(Q'  P'[x::=y]))  Rel" by(metis Res Sym)
    ultimately show ?case by blast
  qed
qed

lemma parAssocLeft:
  fixes P    :: pi
  and   Q    :: pi
  and   R    :: pi
  and   Rel  :: "(pi × pi) set"

  assumes Ass:       "S T U. ((S  T)  U, S  (T  U))  Rel"
  and     Res:       "S T x. (S, T)  Rel  (x>S, x>T)  Rel"
  and     FreshExt:  "S T U x. x  S  (x>((S  T)  U), S  x>(T  U))  Rel"
  and     FreshExt': "S T U x. x  U  ((x>(S  T))  U, x>(S  (T  U)))  Rel"

  shows "(P  Q)  R ↝[Rel] P  (Q  R)"
proof(induct rule: simCases)
  case(Bound a x PQR)
  from x  (P  Q)  R have "x  P" and "x  Q" and "x  R" by simp+
  hence "x  (Q  R)" by simp
  with P  (Q  R)  a«x»  PQR x  P show ?case
  proof(induct rule: parCasesB)
    case(cPar1 P')
    from P  a«x»  P' have "P  Q  a«x»  P'  Q" using x  Q by(rule Par1B)
    hence "(P  Q)  R  a«x»  (P'  Q)  R" using x  R by(rule Par1B)
    moreover have "derivative ((P'  Q)  R) (P'  (Q  R)) a x Rel"
      by(cases a, auto intro: Ass simp add: derivative_def)
    ultimately show ?case by blast
  next
    case(cPar2 QR)
    from Q  R  a«x»  QR x  Q x  R show ?case
    proof(induct rule: parCasesB)
      case(cPar1 Q')
      from Q  a«x»  Q' have "P  Q  a«x»  P  Q'" using x  P by(rule Par2B)
      hence "(P  Q)  R  a«x»  (P  Q')  R" using x  Rby(rule Par1B)
      moreover have "derivative ((P  Q')  R) (P  (Q'  R)) a x Rel"
        by(cases a, auto intro: Ass simp add: derivative_def)
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from R  a«x»  R' have "(P  Q)  R  a«x»  (P  Q)  R'" using x  P x  Q 
        by(rule_tac Par2B) auto
      moreover have "derivative ((P  Q)  R') (P  (Q  R')) a x Rel"
        by(cases a, auto intro: Ass simp add: derivative_def)
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α PQR)
  from P  (Q  R)  α  PQR show ?case
  proof(induct rule: parCasesF[where C="Q"])
    case(cPar1 P')
    from P  α  P' have "P  Q  α  P'  Q" by(rule Par1F)
    hence "(P  Q)  R  α  (P'  Q)  R" by(rule Par1F)
    moreover from Ass have "((P'  Q)  R, P'  (Q  R))  Rel" by blast
    ultimately show ?case by blast
  next
    case(cPar2 QR)
    from Q  R  α  QR show ?case
    proof(induct rule: parCasesF[where C="P"])
      case(cPar1 Q')
      from Q  α  Q' have "(P  Q)  α  P  Q'" by(rule Par2F)
      hence "(P  Q)  R  α  (P  Q')  R" by(rule Par1F)
      moreover from Ass have "((P  Q')  R, P  (Q'  R))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from R  α  R' have "(P  Q)  R  α  (P  Q)  R'" by(rule Par2F)
      moreover from Ass have "((P  Q)  R', P  (Q  R'))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cComm1 Q' R' a b x)
      from Q a<x>  Q' x  P have "P  Q a<x>  P  Q'" by(rule Par2B)
      hence "(P  Q)  R  τ  (P  Q')[x::=b]  R'" using R a[b]  R' by(rule Comm1)
      with x  P have "(P  Q)  R  τ  (P  (Q'[x::=b]))  R'" by(simp add: forget)
      moreover from Ass have "((P  (Q'[x::=b]))  R', P  (Q'[x::=b]  R'))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cComm2 Q' R' a b x)
      from Q a[b]  Q' have "P  Q a[b]  P  Q'" by(rule Par2F)
      with x  P x  Q R a<x>  R' have "(P  Q)  R  τ  (P  Q')  R'[x::=b]"
        by(force intro: Comm2)
      moreover from Ass have "((P  Q')  R'[x::=b], P  (Q'  R'[x::=b]))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cClose1 Q' R' a x y)
      from Q a<x>  Q' x  P have "P  Q a<x>  P  Q'" by(rule Par2B)
      with y  P y  Q x  P R ay>  R' have "(P  Q)  R  τ  y>((P  Q')[x::=y]  R')"
        by(rule_tac Close1) auto
      with x  P have "(P  Q)  R  τ  y>((P  (Q'[x::=y]))  R')" by(simp add: forget)
      moreover from y  P have "(y>((P  Q'[x::=y])  R'), P  y>(Q'[x::=y]  R'))  Rel"
        by(rule FreshExt)
      ultimately show ?case by blast
    next
      case(cClose2 Q' R' a x y)
      from Q ay>  Q' y  P have "P  Q ay>  P  Q'" by(rule Par2B)
      hence Act: "(P  Q)  R  τ  y>((P  Q')  R'[x::=y])" using R a<x>  R' y  R by(rule Close2)
      moreover from y  P have "(y>((P  Q')  R'[x::=y]), P  y>(Q'  R'[x::=y]))  Rel"
        by(rule FreshExt)
      ultimately show ?case by blast
    qed
  next
    case(cComm1 P' QR a b x)
    from Q  R  a[b]  QR show ?case
    proof(induct rule: parCasesF[where C="()"])
      case(cPar1 Q')
      from P a<x>  P' Q a[b]  Q' have "P  Q  τ  P'[x::=b]  Q'" by(rule Comm1)
      hence "(P  Q)  R  τ  (P'[x::=b]  Q')  R" by(rule Par1F)
      moreover from Ass have "((P'[x::=b]  Q')  R, P'[x::=b]  (Q'  R))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from P a<x>  P' x  Q have "P  Q  a<x>  P'  Q" by(rule Par1B)
      hence "(P  Q)  R  τ  (P'  Q)[x::=b]  R'" using R  a[b]  R' by(rule Comm1)
      with x  Q have "(P  Q)  R  τ  (P'[x::=b]  Q)  R'" by(simp add: forget)
      moreover from Ass have "((P'[x::=b]  Q)  R', P'[x::=b]  (Q  R'))  Rel" by blast
      ultimately show ?case by blast
    next
      case(cComm1 Q' R')
      from a[b] = τ have False by simp thus ?case by simp
    next
      case(cComm2 Q' R')
      from a[b] = τ have False by simp thus ?case by simp
    next
      case(cClose1 Q' R')
      from a[b] = τ have False by simp thus ?case by simp
    next
      case(cClose2 Q' R')
      from a[b] = τ have False by simp thus ?case by simp
    qed
  next
    case(cComm2 P' QR a b x)
    from x  Q  R have "x  Q" and "x  R" by simp+
    with Q  R  a<x>  QR show ?case
    proof(induct rule: parCasesB)
      case(cPar1 Q')
      from P a[b]  P' Q  a<x>  Q' have "P  Q  τ  P'  (Q'[x::=b])" by(rule Comm2)
      hence "(P  Q)  R  τ  (P'  Q'[x::=b])  R" by(rule Par1F)
      moreover from Ass have "((P'  Q'[x::=b])  R, P'  Q'[x::=b]  R)  Rel" by blast
      with x  R have "((P'  Q'[x::=b])  R, P'  (Q'  R)[x::=b])  Rel" by(force simp add: forget)
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from P a[b]  P' have "P  Q  a[b]  P'  Q" by(rule Par1F)
      hence "(P  Q)  R  τ  (P'  Q)  (R'[x::=b])" using R a<x>  R' by (rule Comm2)
      moreover from Ass have "((P'  Q)  R'[x::=b], P'  Q  (R'[x::=b]))  Rel" by blast
      hence "((P'  Q)  R'[x::=b], P'  (Q  R')[x::=b])  Rel" using x  Q by(force simp add: forget)
      ultimately show ?case by blast
    qed
  next
    case(cClose1 P' QR a x y)
    from x  Q  R have "x  Q" by simp
    from y  Q  R have "y  Q" and "y  R" by simp+
    from Q  R  ay>  QR y  Q y  R show ?case
    proof(induct rule: parCasesB)
      case(cPar1 Q')
      from P a<x>  P' Q  ay>  Q' y  P have "P  Q  τ  y>(P'[x::=y]  Q')" by(rule Close1)
      hence "(P  Q)  R  τ  (y>(P'[x::=y]  Q'))  R" by(rule Par1F)
      moreover from y  R have "((y>(P'[x::=y]  Q'))  R, y>(P'[x::=y]  Q'  R))  Rel"
        by(rule FreshExt')
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from P a<x>  P' x  Q have "P  Q  a<x>  P'  Q" by(rule Par1B)
      with R  ay>  R' y  P y  Q have "(P  Q)  R  τ  y>((P'  Q)[x::=y]  R')"
        by(rule_tac Close1) auto
      with x  Q have "(P  Q)  R  τ  y>((P'[x::=y]  Q)  R')" by(simp add: forget)
      moreover have "(y>((P'[x::=y]  Q)  R'), y>(P'[x::=y]  (Q  R')))  Rel" by(metis Ass Res)
      ultimately show ?case by blast
    qed
  next
    case(cClose2 P' QR a x y)
    from y  Q  R have "y  Q" and "y  R" by simp+
    from x  Q  R have "x  Q" and "x  R" by simp+
    with Q  R  a<x>  QR show ?case
    proof(induct rule: parCasesB)
      case(cPar1 Q')
      from P ay>  P' Q a<x>  Q' have "P  Q  τ  y>(P'  Q'[x::=y])" using y  Q
        by(rule Close2)
      hence "(P  Q)  R  τ  (y>(P'  Q'[x::=y]))  R" by(rule Par1F)
      moreover from y  R have "((y>(P'  Q'[x::=y]))  R, y>(P'   (Q'[x::=y]  R)))  Rel"
        by(rule FreshExt')
      with x  R have "((y>(P'  Q'[x::=y]))  R, y>(P'   (Q'  R)[x::=y]))  Rel"
        by(simp add: forget)
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from P ay>  P' y  Q have "P  Q  ay>  P'  Q" by(rule Par1B)
      hence "(P  Q)  R  τ  y>((P'  Q)  R'[x::=y])" using R  a<x>  R' y  R by(rule Close2)
      moreover have "((P'  Q)  R'[x::=y], P'  (Q  R'[x::=y]))  Rel" by(rule Ass)
      hence "(y>((P'  Q)  R'[x::=y]), y>(P'  (Q  R'[x::=y])))  Rel" by(rule Res) 
      hence "(y>((P'  Q)  R'[x::=y]), y>(P'  (Q  R')[x::=y]))  Rel" using x  Q
        by(simp add: forget)
      ultimately show ?case by blast
    qed
  qed
qed

lemma substRes3:
  fixes a :: name
  and   P :: pi
  and   x :: name

  shows "(a>P)[x::=a] = x>([(x, a)]  P)"
proof -
  have "a  a>P" by(simp add: name_fresh_abs)
  hence "(a>P)[x::=a] = [(x, a)]  a>P" by(rule injPermSubst[THEN sym])
  thus "(a>P)[x::=a] = x>([(x, a)]  P)" by(simp add: name_calc)
qed

lemma scopeExtParLeft:
  fixes P   :: pi
  and   Q   :: pi
  and   a   :: name
  and   lst :: "name list"
  and   Rel :: "(pi × pi) set"

  assumes "x  P"
  and     Id:         "Id  Rel"
  and     EqvtRel:    "eqvt Rel"
  and     Res:        "R S y. y  R  (y>(R  S), R  y>S)  Rel"
  and     ScopeExt:   "R S y z. y  R  (y>z>(R  S), z>(R  y>S))  Rel"

  shows "x>(P  Q) ↝[Rel] P  x>Q"
using ‹eqvt Rel
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
  case(Bound a y PxQ)
  from y  (x, P, Q) have "y  x" and "y  P" and "y  Q" by simp+
  hence "y  P" and "y  x>Q" by(simp add: abs_fresh)+
  with P  x>Q  a«y»  PxQ show ?case
  proof(induct rule: parCasesB)
    case(cPar1 P')
    from P a«y»  P' x  P y  x have "x  a" and "x  P'"
      by(force intro: freshBoundDerivative)+

    from P a«y»  P' y  Q have "P  Q a«y»  P'  Q" by(rule Par1B)
    with x  a y  x have "x>(P  Q)  a«y»  x>(P'  Q)" by(rule_tac ResB) auto
    moreover have "derivative (x>(P'  Q)) (P'  x>Q) a y Rel"
    proof(cases a, auto simp add: derivative_def)
      fix u

      show "((x>(P'  Q))[y::=u],  P'[y::=u]   ((x>Q)[y::=u]))  Rel"
      proof(cases "x=u")
        case True
        have "(x>(P'  Q))[y::=x] = y>(([(y, x)]  P')  ([(y, x)]  Q))"
          by(simp add: substRes3)
        moreover from x  P' have "P'[y::=x] = [(y, x)]  P'" by(rule injPermSubst[THEN sym])
        moreover have "(x>Q)[y::=x] = y>([(y, x)]  Q)" by(rule substRes3)
        moreover from x  P' y  x have "y  [(y, x)]  P'" by(simp add: name_fresh_left name_calc)
        ultimately show ?thesis using x = uby(force intro: Res)
      next
        case False
        with y  x have "(x>(P'  Q))[y::=u] = x>(P'[y::=u]  Q[y::=u])"
          by(simp add: fresh_prod name_fresh)
        moreover from x  u y  x have "(x>Q)[y::=u] = x>(Q[y::=u])"
          by(simp add: fresh_prod name_fresh)
        moreover from x  P' x  u have "x  P'[y::=u]" by(simp add: fresh_fact1)
        ultimately show ?thesis by(force intro: Res)
      qed
    next
      from x  P' show "(x>(P'  Q), P'  x>Q)  Rel" by(rule Res)
    qed
    
    ultimately show ?case by blast
  next
    case(cPar2 xQ)
    from x>Q a«y»  xQ y  x y  Q show ?case
    proof(induct rule: resCasesB)
      case(cOpen a Q')
      from Q a[x]  Q' y  Q have yFreshQ': "y  Q'" by(force intro: freshFreeDerivative)

      from Q  a[x]  Q' have "P  Q  a[x]  P  Q'" by(rule Par2F)
      hence "x>(P  Q)  ax>  P  Q'" using a  x by(rule Open)
      with y  P y  Q' have "x>(P  Q)  ay>  [(x, y)]  (P  Q')"
        by(subst alphaBoundResidual[where x'=x]) (auto simp add: fresh_left calc_atm)
      with y  P x  P have "x>(P  Q)  ay>  P  ([(x, y)]  Q')"
        by(simp add: name_fresh_fresh)

      moreover have "derivative (P  ([(x, y)]  Q')) (P  ([(y, x)]  Q')) (BoundOutputS a) y Rel" using Id
        by(auto simp add: derivative_def name_swap)
         
      ultimately show ?case by blast
    next
      case(cRes Q')

      from Q  a«y»  Q' y  P have "P  Q  a«y»  P  Q'" by(rule Par2B)
      hence "x>(P  Q)  a«y»  x>(P  Q')" using x  a y  x
        by(rule_tac ResB) auto
      moreover have "derivative (x>(P  Q')) (P  x>Q') a y Rel"
      proof(cases a, auto simp add: derivative_def)
        fix u
        show "((x>(P  Q'))[y::=u],  P[y::=u]   (x>Q')[y::=u])  Rel"
        proof(cases "x=u")
          case True
          from x  P y  P have "(x>(P  Q'))[y::=x] = y>(P  ([(y, x)]  Q'))"
            by(simp add: substRes3 perm_fresh_fresh)
          moreover from y  P have "P[y::=x] = P" by(simp add: forget)
          moreover have "(x>Q')[y::=x] = y>([(y, x)]  Q')" by(rule substRes3)
          ultimately show ?thesis using x=u y  P by(force intro: Res)
        next
          case False
          with y  x have "(x>(P  Q'))[y::=u] = x>((P  Q')[y::=u])"
            by(simp add: fresh_prod name_fresh)
          moreover from y  x x  u have "(x>Q')[y::=u] = x>(Q'[y::=u])"
            by(simp add: fresh_prod name_fresh)
          moreover from x  P x  u have "x  P[y::=u]" by(force simp add: fresh_fact1)
          ultimately show ?thesis by(force intro: Res)
        qed
      next
        from x  P show "(x>(P  Q'), P  x>Q')  Rel" by(rule Res)
      qed
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α PxQ)
  from P  x>Q α  PxQ show ?case
  proof(induct rule: parCasesF[where C="x"])
    case(cPar1 P')
    from P  α  P' x  Phave "x  α" and "x  P'" by(force intro: freshFreeDerivative)+
    from P  α  P' have "P  Q  α  P'  Q" by(rule Par1F)
    hence "x>(P  Q)  α  x>(P'  Q)" using x  α by(rule ResF)
    moreover from x  P' have "(x>(P'  Q), P'  x>Q)  Rel" by(rule Res)
    ultimately show ?case by blast
  next
    case(cPar2 Q')
    from x>Q  α  Q' show ?case
    proof(induct rule: resCasesF)
      case(cRes Q')
      from Q  α  Q' have "P  Q  α  P  Q'" by(rule Par2F)
      hence "x>(P  Q) α  x>(P  Q')" using x  α  by(rule ResF)
      moreover from x  P have "(x>(P  Q'), P  x>Q')  Rel" by(rule Res)
      ultimately show ?case by blast
    qed
  next
    case(cComm1 P' xQ a b y)
    from y  x have "y  x" by simp
    from P  a<y>  P' x  P y  x have "x  P'" by(force intro: freshBoundDerivative)
    from x>Q a[b]  xQ show ?case
    proof(induct rule: resCasesF)
      case(cRes Q')
      from x  a[b] have "x  b" by simp
      from P  a<y>  P' Q  a[b]  Q' have "P  Q  τ  P'[y::=b]  Q'" by(rule Comm1)
      hence "x>(P  Q)  τ  x>(P'[y::=b]  Q')" by(rule_tac ResF) auto
      moreover from x  P' x  b have "x  P'[y::=b]" by(force intro: fresh_fact1)
      hence "(x>(P'[y::=b]  Q'), P'[y::=b]  x>Q')  Rel" by(rule Res)
      ultimately show ?case by blast
    qed
  next
    case(cComm2 P' xQ a b y)
    from y  x y  x>Q have "y  x" and "y  Q" by(simp add: abs_fresh)+ 
    with x>Q a<y>  xQ show ?case
    proof(induct rule: resCasesB)
      case(cOpen b Q')
      from ‹InputS a = BoundOutputS b have False by simp
      thus ?case by simp
    next
      case(cRes Q')
      from P a[b]  P' Q a<y>  Q' have "P  Q  τ  P'  Q'[y::=b]" by(rule Comm2)
      hence "x>(P  Q)  τ  x>(P'  Q'[y::=b])" by(rule_tac ResF) auto
      moreover from P a[b]  P' x  P have "x  P'" and "x  b" by(force dest: freshFreeDerivative)+
      from x  P' have "(x>(P'  Q'[y::=b]), P'  x>(Q'[y::=b]))  Rel" by(rule Res)
      with y  x x  b have "(x>(P'  Q'[y::=b]), P'  (x>Q')[y::=b])  Rel" by simp
      ultimately show ?case by blast
    qed
  next
    case(cClose1 P' Q' a y z)
    from y  x have "y  x" by simp
    from z  x z  x>Q have "z  Q" and "z  x" by(simp add: abs_fresh)+
    from P a<y>  P' z  P have "z  a" by(force dest: freshBoundDerivative)
    from x>Q  az>  Q' z  x z  Q show ?case
    proof(induct rule: resCasesB)
      case(cOpen b Q')
      from ‹BoundOutputS a = BoundOutputS b have "a = b" by simp
      with Q  b[x]  Q' have "([(z, x)]  Q)  [(z, x)]  (a[x]  Q')"
        by(rule_tac transitions.eqvt) simp
      with b  x z  a a = b z  x have "([(z, x)]  Q)  a[z]  ([(z, x)]  Q')"
        by(simp add: name_calc eqvts)
      with P a<y>  P' have "P  ([(z, x)]  Q) τ  P'[y::=z]  ([(z, x)]  Q')"
        by(rule Comm1)
      hence "z>(P  ([(x, z)]  Q))  τ  z>(P'[y::=z]  ([(z, x)]  Q'))"
        by(rule_tac ResF) auto
      hence "x>(P  Q)  τ  z>(P'[y::=z]  ([(z, x)]  Q'))" using z  P z  Q x  P
        by(subst alphaRes[where c=z]) auto
      with Id show ?case by force
    next
      case(cRes Q')
      from P a<y>  P' Q az>  Q' z  P have "P  Q  τ  z>(P'[y::=z]  Q')"
        by(rule Close1)
      hence "x>(P  Q)  τ  x>z>(P'[y::=z]  Q')" by(rule_tac ResF) auto
      moreover from P a<y>  P' y  x x  P have "x  P'"
        by(force dest: freshBoundDerivative)
      with z  x have "x  P'[y::=z]" by(simp add: fresh_fact1)
      hence "(x>z>(P'[y::=z]  Q'), z>(P'[y::=z]  x>Q'))  Rel"
        by(rule ScopeExt)
      ultimately show ?case by blast
    qed
  next
    case(cClose2 P' xQ a y z)
    from z  x z  x>Q have "z  x" and "z  Q" by(auto simp add: abs_fresh)
    from y  x y  x>Q have "y  x" and "y  Q" by(auto simp add: abs_fresh)
    with x>Q a<y>  xQ show ?case
    proof(induct rule: resCasesB)
      case(cOpen b Q')
      from ‹InputS a = BoundOutputS b have False by simp
      thus ?case by simp
    next
      case(cRes Q')
      from P az>  P' Q a<y>  Q' z  Q have "P  Q  τ  z>(P'  Q'[y::=z])"
        by(rule Close2)
      hence "x>(P  Q)  τ  x>z>(P'  (Q'[y::=z]))"
        by(rule_tac ResF) auto
      moreover from P az>  P' x  P z  x have "x  P'" by(force dest: freshBoundDerivative)
      hence "(x>z>(P'  (Q'[y::=z])), z>(P'  (x>(Q'[y::=z]))))  Rel"
        by(rule ScopeExt)
      with z  x y  x have "(x>z>(P'  (Q'[y::=z])), z>(P'  (x>Q')[y::=z]))  Rel"
        by simp
      ultimately show ?case by blast
    qed
  qed
qed

lemma scopeExtParRight:
  fixes P   :: pi
  and   Q   :: pi
  and   a   :: name
  and   Rel :: "(pi × pi) set"

  assumes "x  P"
  and     Id:         "Id  Rel"
  and     "eqvt Rel"
  and     Res:        "R S y. y  R  (R  y>S, y>(R  S))  Rel"
  and     ScopeExt:   "R S y z. y  R  (z>(R  y>S), y>z>(R  S))  Rel"

  shows "P  x>Q ↝[Rel] x>(P  Q)"
using ‹eqvt Rel
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
  case(Bound a y xPQ)
  from y  (x, P, Q) have "y  x" and "y  P" and "y  Q" by simp+
  hence "y  x" and "y  P  Q" by(auto simp add: abs_fresh)
  with x>(P  Q) a«y»  xPQ show ?case
  proof(induct rule: resCasesB)
    case(cOpen a PQ)
    from P  Q a[x]  PQ show ?case
    proof(induct rule: parCasesF[where C="()"])
      case(cPar1 P')
      from P a[x]  P' x  P have "x  x" by(force dest: freshFreeDerivative)
      thus ?case by simp
    next
      case(cPar2 Q')
      from Q a[x]  Q' y  Q have "y  Q'" by(force dest: freshFreeDerivative)
      from Q a[x]  Q' a  x have "x>Q ax>  Q'" by(rule Open)
      hence "P  x>Q ax>  P  Q'" using x  P by(rule Par2B)
      with y  P y  Q' x  P have "P  x>Q ay>  ([(y, x)]  (P  Q'))"
        by(subst alphaBoundResidual[where x'=x]) (auto simp add: fresh_left calc_atm)
      moreover with Id have "derivative ([(y, x)]  (P   Q'))
                                        ([(y, x)]  (P  Q')) (BoundOutputS a) y Rel"
        by(auto simp add: derivative_def)
      ultimately show ?case by blast
    next
      case(cComm1 P' Q' b c y)
      from a[x] = τ show ?case by simp
    next
      case(cComm2 P' Q' b c y)
      from a[x] = τ show ?case by simp
    next
      case(cClose1 P' Q' b y z)
      from a[x] = τ show ?case by simp
    next
      case(cClose2 P' Q' b y z)
      from a[x] = τ show ?case by simp
    qed
  next
    case(cRes PQ)
    from P  Q a«y»  PQ y  P y  Q
    show ?case
    proof(induct rule: parCasesB)
      case(cPar1 P')
      from y  x x  P P a«y»  P' have "x  P'" by(force dest: freshBoundDerivative)
      
      from P a«y»  P' y  Q have "P  x>Q a«y»  P'  x>Q"
        by(rule_tac Par1B) (auto simp add: abs_fresh)
      moreover have "derivative (P'  x>Q) (x>(P'  Q)) a y Rel"
      proof(cases a, auto simp add: derivative_def)
        fix u::name
        obtain z::name where "z  Q" and "y  z" and "z  u" and "z  P" and "z  P'"
          by(generate_fresh "name") auto
        thus "(P'[y::=u]  (x>Q)[y::=u], (x>(P'  Q))[y::=u])  Rel" using x  P'
          by(subst alphaRes[where c=z and a=x], auto)
            (subst alphaRes[where c=z and a=x], auto intro: Res simp add: fresh_fact1)
      next
        from x  P' show "(P'  x>Q, x>(P'  Q))  Rel"
          by(rule Res)
      qed

      ultimately show ?case by blast
    next
      case(cPar2 Q')
      from Q a«y»  Q' have "x>Q a«y»  x>Q'" using x  a y  x 
        by(rule_tac ResB) auto
      hence "P  x>Q a«y»  P  x>Q'" using y  P by(rule Par2B)
      
      moreover have "derivative (P  x>Q') (x>(P  Q')) a y Rel"
      proof(cases a, auto simp add: derivative_def)
        fix u::name
        obtain z::name where "z  Q" and "z  y" and "z  u" and "z  P" and "z  Q'"
          by(generate_fresh "name") auto
        
        thus  "(P[y::=u]  (x>Q')[y::=u], (x>(P  Q'))[y::=u])  Rel" using x  P
          by(subst alphaRes[where a=x and c=z], auto)
            (subst alphaRes[where a=x and c=z], auto intro: Res simp add: fresh_fact1)
      next
        from x  P show "(P  x>Q', x>(P  Q'))  Rel"
          by(rule Res)
      qed
      
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α xPQ)
  from x>(P  Q) α  xPQ show ?case
  proof(induct rule: resCasesF)
    case(cRes PQ)
    from P  Q α  PQ show ?case
    proof(induct rule: parCasesF[where C="x"])
      case(cPar1 P')
      from P α  P' have "P  x>Q α  P'  x>Q" by(rule Par1F)
      moreover from P α  P' x  P have "x  P'" by(rule freshFreeDerivative)
      hence "(P'  x>Q, x>(P'  Q))  Rel" by(rule Res)
      ultimately show ?case by blast
    next
      case(cPar2 Q')
      from Q α  Q' x  α have "x>Q α  x>Q'" by(rule ResF)
      hence "P  x>Q α  P  x>Q'" by(rule Par2F)
      moreover from x  P have "(P  x>Q', x>(P  Q'))  Rel" by(rule Res)
      ultimately show ?case by blast
    next
      case(cComm1 P' Q' a b y)
      from x  P y  x P a<y>  P' have "x  a" and "x  P'" by(force dest: freshBoundDerivative)+
      show ?case
      proof(cases "b=x")
        case True
        from Q a[b]  Q' x  a b = x have "x>Q ax>  Q'" by(rule_tac Open) auto
        with P a<y>  P' have "P  x>Q τ  x>(P'[y::=x]  Q')" using x  P by(rule Close1)
        moreover from Id have "(x>(P'[y::=b]  Q'), x>(P'[y::=b]  Q'))  Rel" by blast
        ultimately show ?thesis using b=x by blast
      next
        case False
        from Q a[b]  Q' x  a b  x have "x>Q a[b]  x>Q'" by(rule_tac ResF) auto
        with P a<y>  P' have "P  x>Q τ  (P'[y::=b]  x>Q')" by(rule Comm1)
        moreover from x  P' b  x have "(P'[y::=b]  x>Q', x>(P'[y::=b]  Q'))  Rel"
          by(force intro: Res simp add: fresh_fact1)
        ultimately show ?thesis by blast
      qed
    next
      case(cComm2 P' Q' a b y)
      from P a[b]  P' x  P have "x  a" and "x  b" and "x  P'" by(force dest: freshFreeDerivative)+
      from Q a<y>  Q' y  x x  a have "x>Q a<y>  x>Q'" by(rule_tac ResB) auto
      with P a[b]  P' have "P  x>Q τ  P'  (x>Q')[y::=b]" by(rule Comm2)
      moreover from x  P' have "(P'  x>(Q'[y::=b]), x>(P'  Q'[y::=b]))  Rel" by(rule Res)
      ultimately show ?case using y  x x  b by force
    next
      case(cClose1 P' Q' a y z)
      from P a<y>  P' x  P y  x have "x  a" and "x  P'" by(force dest: freshBoundDerivative)+
      from Q az>  Q' z  x x  a have "x>Q az>  x>Q'" by(rule_tac ResB) auto
      with P a<y>  P' have "P  x>Q τ  z>(P'[y::=z]  x>Q')" using z  P by(rule Close1)
      moreover from x  P' z  x have "(z>(P'[y::=z]  x>Q'), x>(z>(P'[y::=z]  Q')))  Rel" 
        by(rule_tac ScopeExt) (auto simp add: fresh_fact1)
      ultimately show ?case by blast
    next
      case(cClose2 P' Q' a y z)
      from P az>  P' x  P z  x have "x  a" and "x  P'" by(force dest: freshBoundDerivative)+
      from Q a<y>  Q' y  x x  a have "x>Q a<y>  x>Q'" by(rule_tac ResB) auto
      with P az>  P' have "P  x>Q τ  z>(P'  (x>Q')[y::=z])" using z  Q
        by(rule_tac Close2) (auto simp add: abs_fresh)
      moreover from x  P' have "(z>(P'  x>(Q'[y::=z])), x>z>(P'  Q'[y::=z]))  Rel" by(rule ScopeExt)
      ultimately show ?case using z  x y  x by force
    qed
  qed
qed

lemma resNilRight:
  fixes x   :: name
  and   Rel :: "(pi × pi) set"

  shows "𝟬 ↝[Rel] x>𝟬"
by(fastforce simp add: simulation_def pi.inject alpha' elim: resCasesB' resCasesF)

lemma resComm:
  fixes a   :: name
  and   b   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes ResComm: "c d Q. (c>d>Q, d>c>Q)  Rel"
  and     Id:      "Id  Rel"
  and     EqvtRel: "eqvt Rel"

  shows "a>b>P ↝[Rel] b>a>P"
proof(cases "a=b")
  assume "a=b"
  with Id show ?thesis by(force intro: Strong_Late_Sim.reflexive)
next
  assume aineqb: "a  b"
  from EqvtRel show ?thesis
  proof(induct rule: simCasesCont[where C="(a, b, P)"])
    case(Bound c x baP)
    from x  (a, b, P) have "x  a" and "x  b" and "x  P" by simp+
    from x  P have "x  a>P" by(simp add: abs_fresh)
    with b>a>P  c«x»  baP x  b show ?case
    proof(induct rule: resCasesB)
      case(cOpen c aP)
      from a>P c[b]  aP
      show ?case
      proof(induct rule: resCasesF)
        case(cRes P')
        from a  c[b] have "a  c" and "a  b" by simp+
        from x  P P c[b]  P' have "x  c" and "x  P'" by(force dest: freshFreeDerivative)+
        from P  c[b]  P' have "([(x, b)]  P)  [(x, b)]  (c[b]  P')" by(rule transitions.eqvt)
        with x  c c  b x  b have "([(x, b)]  P)  c[x]  [(x, b)]  P'" by(simp add: eqvts calc_atm)
        hence "x>([(x, b)]  P)  cx>  [(x, b)]  P'" using x  c by(rule_tac Open) auto
        with x  P have "b>P  cx>  [(x, b)]  P'" by(simp add: alphaRes)
        hence "a>b>P  cx>  a>([(x, b)]  P')" using a  c x  a
          by(rule_tac ResB) auto
        moreover from Id have "derivative (a>([(x, b)]  P')) (a>([(x, b)]  P')) (BoundOutputS c) x Rel"
          by(force simp add: derivative_def)
        ultimately show ?case using a  b x  a a  c by(force simp add: eqvts calc_atm)
      qed
    next
      case(cRes aP)
      from a>P  c«x»  aP x  a x  P b  c show ?case
      proof(induct rule: resCasesB)
        case(cOpen c P')
        from P c[a]  P' x  P have "x  P'" by(force intro: freshFreeDerivative)
        from b  BoundOutputS c have "b  c" by simp
        with P c[a]  P' a  b have "b>P  c[a]  b>P'" by(rule_tac ResF) auto
        with c  a have "a>b>P  ca>  b>P'" by(rule_tac Open) auto
        hence "a>b>P cx>  b>([(x, a)]  P')" using x  b a  b x  P'
          apply(subst alphaBoundResidual[where x'=a]) by(auto simp add: abs_fresh fresh_left calc_atm)
        moreover have "derivative (b>([(x, a)]  P')) (b>([(x, a)]  P')) (BoundOutputS c) x Rel" using Id
          by(force simp add: derivative_def)
        ultimately show ?case by blast
      next
        case(cRes P')
        from P c«x»  P' b  c x  b have "b>P  c«x»  b>P'" by(rule_tac ResB) auto
        hence "a>b>P  c«x»  a>b>P'" using a  c x  a by(rule_tac ResB) auto
        moreover have "derivative (a>b>P') (b>a>P') c x Rel"
        proof(cases c, auto simp add: derivative_def)
          fix u::name
          show  "((a>b>P')[x::=u],  (b>a>P')[x::=u])  Rel"
          proof(cases "u=a")
            case True
            from u = a a  b show ?thesis
              by(subst injPermSubst[symmetric], auto simp add: abs_fresh)
                (subst injPermSubst[symmetric], auto simp add: abs_fresh calc_atm intro: ResComm)
          next
            case False
            show ?thesis
            proof(cases "u=b")
              case True
              from u = b u  a show ?thesis
              by(subst injPermSubst[symmetric], auto simp add: abs_fresh)
                (subst injPermSubst[symmetric], auto simp add: abs_fresh calc_atm intro: ResComm)
            next
              case False
              from u  a u  b x  a x  b show ?thesis by(auto intro: ResComm)
            qed
          qed
        next
          show "(a>b>P', b>a>P')  Rel" by(rule ResComm)
        qed
        ultimately show ?case by blast
      qed
    qed
  next
    case(Free α baP)
    from b>a>P  α  baP show ?case
    proof(induct rule: resCasesF)
      case(cRes aP)
      from a>P  α  aP show ?case
      proof(induct rule: resCasesF)
        case(cRes P')
        from P  α  P' b  α have "b>P  α  b>P'" by(rule ResF)
        hence "a>b>P  α  a>b>P'" using a  α by(rule ResF)
        moreover have "(a>b>P', b>a>P')  Rel" by(rule ResComm)
        ultimately show ?case by blast
      qed
    qed
  qed
qed

(***************** !-operator ********************)

lemma bangLeftSC:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "!P ↝[Rel] P  !P"
using assms
by(force simp add: simulation_def dest: Bang derivativeReflexive)

lemma bangRightSC:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes IdRel: "Id  Rel"

  shows "P  !P ↝[Rel] !P"
using assms
by(fastforce simp add: pi.inject simulation_def intro: derivativeReflexive elim: bangCases)

lemma resNilLeft:
  fixes x   :: name
  and   y   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"
  and   b   :: name

  shows "𝟬 ↝[Rel] x>(x<y>.P)"
  and   "𝟬 ↝[Rel] x>(x{b}.P)"
by(auto simp add: simulation_def)

lemma resInputLeft:
  fixes x :: name
  and   a :: name
  and   y :: name
  and   P :: pi
  and   Rel :: "(pi × pi) set"

  assumes xineqa: "x  a"
  and     xineqy: "x  y"
  and     Eqvt: "eqvt Rel"
  and     Id: "Id  Rel"

  shows "x>a<y>.P ↝[Rel] a<y>.(x>P)"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, y, a, P)"])
  case(Bound b z P')
  from z  (x, y, a, P) have "z  x" and "z  y" and "z  P" and "z  a"  by simp+
  from z  P have "z  x>P" by(simp add: abs_fresh)
  with a<y>.(x>P) b«z»  P' z  a z  y show ?case
  proof(induct rule: inputCases)
    case cInput
    have "a<y>.P a<y>  P" by(rule Input)
    with x  y x  a have "x>a<y>.P a<y>  x>P" by(rule_tac ResB) auto
    hence "x>a<y>.P a<z>  [(y,  z)]  x>P" using z  P 
      by(subst alphaBoundResidual[where x'=y]) (auto simp add: abs_fresh fresh_left calc_atm)
    moreover from Id have "derivative ([(y, z)]  x>P) ([(y, z)]  x>P) (InputS a) z Rel" 
      by(rule derivativeReflexive)
    ultimately show ?case by blast
  qed
next
  case(Free α P')
  from a<y>.(x>P) α  P' have False by auto
  thus ?case by simp
qed

lemma resInputRight:
  fixes a :: name
  and   y :: name
  and   x :: name
  and   P :: pi
  and   Rel :: "(pi × pi) set"

  assumes xineqa: "x  a"
  and     xineqy: "x  y"
  and     Eqvt: "eqvt Rel"
  and     Id: "Id  Rel"

  shows "a<y>.(x>P) ↝[Rel] x>a<y>.P"
  using Eqvt
proof(induct rule: simCasesCont[where C="(x, y, a, P)"])
  case(Bound b z xP)
  from z  (x, y, a, P) have "z  x" and "z  y" and "z  P" and "z  a" by simp+
  from z  a z  P have "z  a<y>.P" by(simp add: abs_fresh)
  with x>a<y>.P b«z»  xP z  x show ?case
  proof(induct rule: resCasesB)
    case(cOpen b P')
    from a<y>.P b[x]  P' have False by auto
    thus ?case by simp
  next
    case(cRes P')
    from a<y>.P b«z»  P'z  a z  y z  P show ?case
    proof(induct rule: inputCases)
      case cInput
      have "a<y>.(x>P) a<y>  (x>P)" by(rule Input)
      with z  P x  y z  x have "a<y>.(x>P) a<z>  (x>([(y, z)]  P))"
        by(subst alphaBoundResidual[where x'=y]) (auto simp add: abs_fresh calc_atm fresh_left)
      moreover from Id have "derivative (x>([(y, z)]  P)) (x>([(y, z)]  P)) (InputS a) z Rel"
        by(rule derivativeReflexive)
      ultimately show ?case by blast
    qed
  qed
next
  case(Free α P')
  from x>a<y>.P α  P' have False by auto
  thus ?case by simp
qed

lemma resOutputLeft:
  fixes x   :: name
  and   a   :: name
  and   b   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes xineqa: "x  a"
  and     xineqb: "x  b"
  and     Id: "Id  Rel"

  shows "x>a{b}.P ↝[Rel] a{b}.(x>P)"
using assms
by(fastforce simp add: simulation_def elim: outputCases intro: Output ResF)

lemma resOutputRight:
  fixes x   :: name
  and   a   :: name
  and   b   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes xineqa: "x  a"
  and     xineqb: "x  b"
  and     Id: "Id  Rel"
  and     Eqvt: "eqvt Rel"

  shows "a{b}.(x>P) ↝[Rel] x>a{b}.P"
using assms
by(erule_tac simCasesCont[where C=x])
  (force simp add: abs_fresh elim: resCasesB resCasesF outputCases intro: ResF Output)+

lemma resTauLeft:
  fixes x   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id: "Id  Rel"

  shows "x>(τ.(P)) ↝[Rel] τ.(x>P)"
using assms
by(force simp add: simulation_def elim: tauCases resCasesF intro: Tau ResF)

lemma resTauRight: 
  fixes x   :: name
  and   P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Id:   "Id  Rel"

  shows "τ.(x>P) ↝[Rel] x>(τ.(P))"
using assms
by(force simp add: simulation_def elim: tauCases resCasesF intro: Tau ResF)

end

Theory Strong_Late_Bisim_SC

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Bisim_SC
  imports Strong_Late_Bisim_Pres Strong_Late_Sim_SC
begin

lemma nilBisim[dest]:
  fixes a :: name
  and   b :: name
  and   x :: name
  and   P :: pi

  shows "τ.(P)  𝟬  False"
  and   "a<x>.P  𝟬  False"
  and   "a{b}.P  𝟬  False"
  and   "𝟬  τ.(P)  False"
  and   "𝟬  a<x>.P  False"
  and   "𝟬  a{b}.P  False"
by(auto dest: bisimE symmetric)

(******** Structural Congruence **********)

lemma matchId:
  fixes a :: name
  and   P :: pi

  shows "[aa]P  P"
proof -
  let ?X = "{([aa]P, P), (P, [aa]P)}"
  have "([aa]P, P)  ?X" by simp
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto intro: matchIdLeft matchIdRight reflexive)
qed

lemma matchNil:
  fixes a :: name
  and   b :: name

  assumes "a  b"

  shows "[ab]P  𝟬"
proof -
  let ?X = "{([ab]P, 𝟬), (𝟬, [ab]P)}"
  have "([ab]P, 𝟬)  ?X" by simp
  thus ?thesis using a  b
    by(coinduct rule: bisimCoinduct) (auto intro: matchNilLeft nilSimRight reflexive)
qed

lemma mismatchId:
  fixes a :: name
  and   b :: name
  and   P :: pi

  assumes "a  b"

  shows "[ab]P  P"
proof -
  let ?X = "{([ab]P, P), (P, [ab]P)}"
  have "([ab]P, P)  ?X" by simp
  thus ?thesis using a  b
    by(coinduct rule: bisimCoinduct) (auto intro: mismatchIdLeft mismatchIdRight reflexive)
qed

lemma mismatchNil:
  fixes a :: name
  and   P :: pi
  
  shows "[aa]P  𝟬"
proof -
  let ?X = "{([aa]P, 𝟬), (𝟬, [aa]P)}"
  have "([aa]P, 𝟬)  ?X" by simp
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto intro: mismatchNilLeft nilSimRight reflexive)
qed
(******** The ν-operator *****************)

lemma nilRes:
  fixes x :: name

  shows "x>𝟬  𝟬"
proof -
  let ?X = "{(x>𝟬, 𝟬), (𝟬, x>𝟬)}"
  have "(x>𝟬, 𝟬)  ?X" by simp
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto intro: nilSimRight resNilRight)
qed

lemma resComm:
  fixes x :: name
  and   y :: name
  and   P :: pi
  
  shows "x>y>P  y>x>P"
proof -
  let ?X = "{(x>y>P, y>x>P) | x y P. True}"
  have "(x>y>P, y>x>P)  ?X" by auto
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim xyP yxP)
    {
      fix x y P
      have "x y P. (x>y>P, y>x>P)  ?X  bisim" by auto
      moreover have "Id  ?X  bisim" by(auto intro: reflexive)
      moreover have "eqvt ?X" by(force simp add: eqvt_def)
      hence "eqvt(?X  bisim)" by auto
      ultimately have "x>y>P ↝[(?X  bisim)] y>x>P" by(rule resComm)
    }
    with (xyP, yxP)  ?X show ?case by auto
  next
    case(cSym xyP yxP)
    thus ?case by auto
  qed
qed

(******** The +-operator *********)

lemma sumSym:
  fixes P :: pi
  and   Q :: pi
  
  shows "P  Q  Q  P"
proof -
  let ?X = "{(P  Q, Q  P), (Q  P, P  Q)}"
  have "(P  Q, Q  P)  ?X" by simp
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto intro: reflexive sumSym)
qed

lemma sumIdemp:
  fixes P :: pi
  
  shows "P  P  P"
proof -
  let ?X = "{(P  P, P), (P, P  P)}"
  have "(P  P, P)  ?X" by simp
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto intro: reflexive sumIdempLeft sumIdempRight)
qed

lemma sumAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  shows "(P  Q)  R  P  (Q  R)"
proof -
  let ?X = "{((P  Q)  R, P  (Q  R)), (P  (Q  R), (P  Q)  R)}"
  have "((P  Q)  R, P  (Q  R))  ?X" by simp
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto intro: reflexive sumAssocLeft sumAssocRight)
qed

lemma sumZero:
  fixes P :: pi
  
  shows "P  𝟬  P"
proof -
  let ?X = "{(P  𝟬, P), (P, P  𝟬)}"
  have "(P  𝟬, P)  ?X" by simp
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto intro: reflexive sumZeroLeft sumZeroRight)
qed

(******** The |-operator *********)

lemma parZero:
  fixes P :: pi
  
  shows "P  𝟬  P"
proof -
  let ?X = "{(P  𝟬, P) | P. True}  {(P, P  𝟬) | P . True}"
  have "(P  𝟬, P)  ?X" by blast
  thus ?thesis
    by(coinduct rule: bisimCoinduct, auto intro: parZeroRight parZeroLeft)
qed

lemma parSym:
  fixes P :: pi
  and   Q :: pi

  shows "P  Q  Q  P"
proof -
  let ?X = "{(resChain lst (P  Q), resChain lst (Q  P)) | lst P Q. True}"
  have "(P  Q, Q  P)  ?X" by(blast intro: resChain.base[THEN sym])
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim PQ QP)
    {
      fix lst P Q
      have "P Q. (P  Q, Q  P)  ?X  bisim" by(blast intro: resChain.base[THEN sym])
      moreover have Res: "x P Q. (P, Q)  ?X  bisim  (x>P, x>Q)  ?X  bisim"
        by(auto intro: resPres resChain.step[THEN sym])
      ultimately have "P  Q ↝[(?X  bisim)] Q  P" by(rule parSym)
      moreover have "eqvt ?X" by(force simp add: eqvt_def) 
      hence "eqvt(?X  bisim)" by auto
      ultimately have "resChain lst (P  Q) ↝[(?X  bisim)] resChain lst (Q  P)" using Res
        by(rule resChainI)
    }
    with (PQ, QP)  ?X show ?case by auto
  next
    case(cSym PQ QP)
    thus ?case by auto
  qed
qed

lemma scopeExtPar:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x  P"

  shows "x>(P  Q)  P  x>Q"
proof -
  let ?X = "{(resChain lst (x>(P  Q)), resChain lst (P  x>Q)) | lst x P Q. x  P} 
            {(resChain lst (P  x>Q), resChain lst (x>(P  Q))) | lst x P Q. x  P}"
  let ?Y = "bisim O (?X  bisim) O bisim"

  have Res: "P Q x. (P, Q)  ?X  (x>P, x>Q)  ?X" by(blast intro: resChain.step[THEN sym])

  from x  P have "(x>(P  Q), P  x>Q)  ?X" by(blast intro: resChain.base[THEN sym])
  moreover have EqvtX: "eqvt ?X" by(fastforce simp add: eqvt_def name_fresh_left name_rev_per)
  ultimately show ?thesis
  proof(coinduct rule: bisimTransitiveCoinduct)
    case(cSim P Q)
    {
      fix P Q lst x
      assume "(x::name)  (P::pi)"
      moreover have "Id  ?Y" by(blast intro: reflexive)
      moreover from ‹eqvt ?X bisimEqvt have "eqvt ?Y" by blast
      moreover have "P Q x. x  P  (x>(P  Q), P  x>Q)  ?Y"
        by(blast intro: resChain.base[THEN sym] reflexive)
      moreover {
        fix P Q x y
        have "x>y>(P  Q)  y>x>(P  Q)" by(rule resComm)
        moreover assume "x  P"
        hence "(x>(P  Q), P  x>Q)  ?X" by(fastforce intro: resChain.base[THEN sym])
        hence "(y>x>(P  Q), y>(P  x>Q))  ?X" by(rule Res)
        ultimately have  "(x>y>(P  Q), y>(P  x>Q))  ?Y" by(blast intro: reflexive)
      }
      ultimately have "x>(P  Q) ↝[?Y] (P  x>Q)" by(rule scopeExtParLeft) 
      moreover note ‹eqvt ?Y
      moreover from Res have "P Q x. (P, Q)  ?Y  (x>P, x>Q)  ?Y"
        by(blast intro: resChain.step[THEN sym] dest: resPres)
      ultimately have "resChain lst (x>(P  Q)) ↝[?Y] resChain lst (P  x>Q)" 
        by(rule resChainI)
    }
    moreover {
      fix P Q lst x
      assume "(x::name)  (P::pi)"
      moreover have "Id  ?Y" by(blast intro: reflexive)
      moreover from ‹eqvt ?X bisimEqvt have "eqvt ?Y" by blast
      moreover have "P Q x. x  P  (P  x>Q, x>(P  Q))  ?Y"
        by(blast intro: resChain.base[THEN sym] reflexive)
      moreover {
        fix P Q x y
        have "y>x>(P  Q)  x>y>(P  Q)" by(rule resComm)
        moreover assume "x  P"
        hence "(P  x>Q, x>(P  Q))  ?X" by(fastforce intro: resChain.base[THEN sym])
        hence "(y>(P  x>Q), y>x>(P  Q))  ?X" by(rule Res)
        ultimately have  "(y>(P  x>Q), x>y>(P  Q))  ?Y" by(blast intro: reflexive)
      }
      ultimately have "(P  x>Q) ↝[?Y] x>(P  Q)" 
        by(rule scopeExtParRight) 
      moreover note ‹eqvt ?Y
      moreover from Res have "P Q x. (P, Q)  ?Y  (x>P, x>Q)  ?Y"
        by(blast intro: resChain.step[THEN sym] dest: resPres)
      ultimately have "resChain lst (P  x>Q) ↝[?Y] resChain lst (x>(P  Q))" 
        by(rule resChainI)
    }
    ultimately show ?case using (P, Q)  ?X by auto
  next
    case(cSym P Q)
    thus ?case 
      by auto (blast dest: symmetric transitive intro: resChain.base[THEN sym] reflexive)+
  qed
qed

lemma scopeExtPar':
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes xFreshQ: "x  Q"

  shows "x>(P  Q)  (x>P)  Q"
proof -
  have "x>(P  Q)  x>(Q  P)"
  proof -
    have "P  Q  Q  P" by(rule parSym)
    thus ?thesis by(rule resPres)
  qed
  moreover from xFreshQ have "x>(Q  P)  Q  (x>P)" by(rule scopeExtPar)
  moreover have "Q  x>P  (x>P)  Q" by(rule parSym)
  ultimately show ?thesis by(blast intro: transitive)
qed

lemma parAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  shows "(P  Q)  R  P  (Q  R)"
proof -
  let ?X = "{(resChain lst ((P  Q)  R), resChain lst (P  (Q  R))) | lst P Q R. True}"
  let ?Y = "bisim O (?X  bisim) O bisim"

  have ResX: "P Q x. (P, Q)  ?X  (x>P, x>Q)  ?X" 
    by(blast intro: resChain.step[symmetric])
  hence ResY: "P Q x. (P, Q)  ?Y  (x>P, x>Q)  ?Y"
    by(blast intro: resChain.step[symmetric] dest: resPres)

  have "((P  Q)  R, P  (Q  R))  ?X" by(blast intro: resChain.base[symmetric])
  moreover have "eqvt ?X" by(fastforce simp add: eqvt_def) 
  ultimately show ?thesis
  proof(coinduct rule: bisimTransitiveCoinduct)
    case(cSim P Q)
    {
      fix P Q R lst
      have "P Q R. ((P  Q)  R, P  (Q  R))  ?Y" by(blast intro: reflexive resChain.base[symmetric])
      moreover have "P Q x. (P, Q)  ?Y  (x>P, x>Q)  ?Y" by(blast intro: resChain.step[symmetric] resPres)
      moreover {
        fix P Q R x
        have "(x>((P  Q)  R), x>(P  (Q  R)))  ?X" by(rule_tac ResX) (blast intro: resChain.base[symmetric])
        moreover assume "x  P"
        hence "x>(P  (Q  R))  P  x>(Q  R)" by(rule scopeExtPar)
        ultimately have "(x>((P  Q)  R), P  x>(Q  R))  ?Y" by(blast intro: reflexive)
      }
      moreover {
        fix P Q R x
        have "(x>((P  Q)  R), x>(P  (Q  R)))  ?X" by(rule_tac ResX) (blast intro: resChain.base[symmetric])
        moreover assume "x  R"
        hence "x>(P  Q)  R  x>((P  Q)  R)" by(metis scopeExtPar' symmetric)
        ultimately have "(x>(P  Q)  R, x>(P  (Q  R)))  ?Y" by(blast intro: reflexive)
      }
      ultimately have "(P  Q)  R ↝[?Y] P  (Q  R)" by(rule parAssocLeft)
      moreover from ‹eqvt ?X bisimEqvt have "eqvt ?Y" by blast
      ultimately have "resChain lst ((P  Q)  R) ↝[?Y] resChain lst (P  (Q  R))" using ResY
        by(rule resChainI)
    }
    with (P, Q)  ?X show ?case by auto
  next
    case(cSym P Q)
    {
      fix P Q R lst
      have "P  (Q  R)  (R  Q)  P" by(metis parPres parSym transitive)
      moreover have "((R  Q)  P, R  (Q  P))  ?X" by(blast intro: resChain.base[symmetric])
      moreover have "R  (Q  P)  (P  Q)  R" by(metis parPres parSym transitive)
      ultimately have "(P  (Q  R), (P  Q)  R)  ?Y" by blast
      hence "(resChain lst (P  (Q  R)), resChain lst ((P  Q)  R))  ?Y" using ResY
        by(induct lst) auto
    }
    with (P, Q)  ?X show ?case by blast
  qed
qed

lemma scopeFresh:
  fixes x :: name
  and   P :: pi

  assumes "x  P"

  shows "x>P  P"
proof -
  have "x>P  x>P  𝟬" by(rule parZero[THEN symmetric])

  moreover have "x>P  𝟬  𝟬  x>P" by(rule parSym)
  moreover have "𝟬  x>P  x>(𝟬  P)" by(rule scopeExtPar[THEN symmetric]) auto
  moreover have "x>(𝟬  P)  x>(P  𝟬)" by(rule resPres[OF parSym])
  moreover from x  P have "x>(P  𝟬)  P  x>𝟬" by(rule scopeExtPar)
  moreover have  "P  x>𝟬  x>𝟬  P" by(rule parSym)
  moreover have "x>𝟬  P  𝟬  P" by(rule parPres[OF nilRes])
  moreover have "𝟬  P  P  𝟬" by(rule parSym)
  moreover have "P  𝟬  P" by(rule parZero)
  ultimately show ?thesis by(metis transitive)
qed

lemma sumRes:
  fixes x :: name
  and   P :: pi
  and   Q :: pi

  shows "x>(P  Q)  (x>P)  (x>Q)"
proof -
  let ?X = "{(x>(P  Q), x>P  x>Q) | x P Q. True} 
            {(x>P  x>Q, x>(P  Q)) | x P Q. True}"
  have "(x>(P  Q), x>P  x>Q)  ?X" by auto
  moreover have "eqvt ?X" by(fastforce simp add: eqvt_def)
  ultimately show ?thesis
    by(coinduct rule: bisimCoinduct) (fastforce intro: sumResLeft sumResRight reflexive)+
qed


lemma scopeExtSum:
  fixes P :: pi
  and   Q :: pi
  and   x :: name
  
  assumes "x  P"

  shows "x>(P  Q)  P  x>Q"
proof -
  have "x>(P  Q)  x>P  x>Q" by(rule sumRes)
  moreover from x  P have "x>P  x>Q  P  x>Q"
    by(rule sumPres[OF scopeFresh])
  ultimately show ?thesis by(rule transitive)
qed

lemma bangSC:
  fixes P :: pi

  shows "!P  P  !P"
proof -
  let ?X = "{(!P, P  !P), (P  !P, !P)}"
  have "(!P, P  !P)  ?X" by simp
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto intro: bangLeftSC bangRightSC reflexive)
qed

lemma resNil:
  fixes x :: name
  and   y :: name
  and   P :: pi
  and   b :: name

  shows "x>x<y>.P  𝟬"
  and   "x>x{b}.P  𝟬"
proof -
  let ?X = "{(x>x<y>.P, 𝟬), (𝟬, x>x<y>.P)}"
  have "(x>x<y>.P, 𝟬)  ?X" by simp
  thus "x>x<y>.P  𝟬"
    by(coinduct rule: bisimCoinduct) (auto simp add: simulation_def)
next
  let ?X = "{(x>x{b}.P, 𝟬), (𝟬, x>x{b}.P)}"
  have "(x>x{b}.P, 𝟬)  ?X" by simp
  thus "x>x{b}.P  𝟬"
    by(coinduct rule: bisimCoinduct) (auto simp add: simulation_def)
qed

lemma resInput:
  fixes x :: name
  and   a :: name
  and   y :: name
  and   P :: pi

  assumes "x  a"
  and     "x  y"

  shows "x>a<y>.P  a<y>.(x>P)"
proof -
  let ?X = "{(x>a<y>.P, a<y>.(x>P)) | x a y P. x  a  x  y} 
            {(a<y>.(x>P), x>a<y>.P) | x a y P. x  a  x  y}"
  from assms have "(x>a<y>.P, a<y>.(x>P))  ?X" by auto
  moreover have "eqvt ?X" by(fastforce simp add: eqvt_def pt_bij[OF pt_name_inst, OF at_name_inst])
  ultimately show ?thesis
    by(coinduct rule: bisimCoinduct) (fastforce intro: resInputLeft reflexive resInputRight)+
qed

lemma resOutput:
  fixes x :: name
  and   a :: name
  and   b :: name
  and   P :: pi

  assumes "x  a"
  and     "x  b"

  shows "x>a{b}.P  a{b}.(x>P)"
proof -
  let ?X = "{(x>a{b}.P, a{b}.(x>P)) | x a b P. x  a  x  b} 
            {(a{b}.(x>P), x>a{b}.P) | x a b P. x  a  x  b}"
  from assms have "(x>a{b}.P, a{b}.(x>P))  ?X" by blast
  moreover have "eqvt ?X" by(fastforce simp add: eqvt_def pt_bij[OF pt_name_inst, OF at_name_inst])
  ultimately show ?thesis
    by(coinduct rule: bisimCoinduct) (fastforce intro: resOutputLeft resOutputRight reflexive)+
qed

lemma resTau:
  fixes x :: name
  and   P :: pi

  shows "x>τ.(P)  τ.(x>P)"
proof -
  let ?X = "{(x>τ.(P), τ.(x>P)), (τ.(x>P), x>τ.(P))}"
  have "(x>τ.(P), τ.(x>P))  ?X" by auto
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (fastforce intro: resTauLeft resTauRight reflexive)+
qed

inductive structCong :: "pi  pi  bool" ("_ s _" [70, 70] 70)
where
  Refl: "P s P"
| Sym:  "P s Q  Q s P"
| Trans: "P s Q; Q s R  P s R"

| SumComm: "P  Q s Q  P"
| SumAssoc: "(P  Q)  R s P  (Q  R)"
| SumId: "P  𝟬 s P"

| ParComm: "P  Q s Q  P"
| ParAssoc: "(P  Q)  R s P  (Q  R)"
| ParId: "P  𝟬 s P"

| MatchId: "[aa]P s P"

| ResNil: "x>𝟬 s 𝟬"
| ResComm: "x>y>P s y>x>P"
| ResSum: "x>(P  Q) s x>P  x>Q"
| ScopeExtPar: "x  P  x>(P  Q) s P  x>Q"
| InputRes: "x  a; x  y  x>a<y>.P s a<y>.(x>P)"
| OutputRes: "x  a; x  b  x>a{b}.P s a{b}.(x>P)"
| TauRes: "x>τ.(P) s τ.(x>P)"

| BangUnfold: "!P s P  !P"

lemma structCongBisim:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"

  shows "P  Q"
using assms
by(induct rule: structCong.induct)
  (auto intro: reflexive symmetric transitive sumSym sumAssoc sumZero parSym parAssoc parZero
               nilRes resComm resInput resOutput resTau sumRes scopeExtPar bangSC matchId mismatchId)

end

Theory Strong_Late_Bisim_Subst_SC

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Bisim_Subst_SC
  imports Strong_Late_Bisim_Subst_Pres Strong_Late_Bisim_SC
begin

lemma matchId:
  fixes a :: name
  and   P :: pi

  shows "[aa]P s P"
by(auto simp add: substClosed_def intro: Strong_Late_Bisim_SC.matchId)

lemma mismatchNil:
  fixes a :: name
  and   P :: pi
  
  shows "[aa]P s 𝟬"
by(auto simp add: substClosed_def intro: Strong_Late_Bisim_SC.mismatchNil)

lemma scopeFresh:
  fixes P :: pi
  and   x :: name

  assumes xFreshP: "x  P"

  shows "x>P s P"
proof(auto simp add: substClosed_def)
  fix s :: "(name × name) list"

  have "c::name. c  (P, s)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshs: "c  s" by(force simp add: fresh_prod)

  have "x>P = c>P"
  proof -
    from cFreshP have "x>P = c>([(x, c)]  P)" by(simp add: alphaRes)
    with cFreshP xFreshP show ?thesis by(simp add: name_fresh_fresh)
  qed

  with cFreshP cFreshs show "(x>P)[<s>]  P[<s>]"
    by(force intro: Strong_Late_Bisim_SC.scopeFresh)
qed

lemma resComm:
  fixes P :: pi
  and   x :: name
  and   y :: name

  shows "x>y>P s y>x>P"
proof(cases "x=y")
  assume xeqy: "x=y"
  have "P s P" by(rule Strong_Late_Bisim_Subst.reflexive)
  hence "x>P s x>P" by(rule resPres)
  hence "x>x>P s x>x>P" by(rule resPres)
  with xeqy show ?thesis by simp
next
  assume xineqy: "x  y"
  show ?thesis
  proof(auto simp add: substClosed_def)
    fix s::"(name × name) list"
    
    have "c::name. c  (P, s, y)" by(blast intro: name_exists_fresh)
    then obtain c::name where cFreshP: "c  P" and cFreshs: "c  s" and cineqy: "c  y"
      by(force simp add: fresh_prod)
    
    have "d::name. d  (P, s, c, x, y)" by (blast intro: name_exists_fresh)
    then obtain d::name where dFreshP: "d  P" and dFreshs: "d  s" and dineqc: "d  c"
                          and dineqx: "d  x" and dineqy: "d  y"
      by(force simp add: fresh_prod)

    have "x>y>P = c>d>([(x, c)]  [(y, d)]  P)"
    proof -
      from cineqy cFreshP have cFreshyP: "c  y>P" by(simp add: name_fresh_abs)
      from dFreshP have "y>P = d>([(y, d)]  P)" by(rule alphaRes)
      moreover from cFreshyP have "x>y>P = c>([(x, c)]  (y>P))" by(rule alphaRes)
      ultimately show ?thesis using dineqc dineqx by(simp add: name_calc)
    qed
    moreover have "y>x>P = d>c>([(x, c)]  [(y, d)]  P)"
    proof -
      from dineqx dFreshP have dFreshxP: "d  x>P" by(simp add: name_fresh_abs)
      from cFreshP have "x>P = c>([(x, c)]  P)" by(rule alphaRes)
      moreover from dFreshxP have "y>x>P = d>([(y, d)]  (x>P))" by(rule alphaRes)
      ultimately have "y>x>P = d>c>([(y, d)]  [(x, c)]  P)" using dineqc cineqy
        by(simp add: name_calc)
      thus ?thesis using dineqx dineqc cineqy xineqy
        by(subst name_perm_compose, simp add: name_calc)
    qed

    ultimately show "(x>y>P)[<s>]  (y>x>P)[<s>]" using cFreshs dFreshs
      by(force intro: Strong_Late_Bisim_SC.resComm)
  qed
qed

lemma sumZero:
  fixes P :: pi
  
  shows "P  𝟬 s P"
by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.sumZero)
    
lemma sumSym:
  fixes P :: pi
  and   Q :: pi

  shows "P  Q s Q  P"
by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.sumSym)

lemma sumAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  shows "(P  Q)  R s P  (Q  R)"
by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.sumAssoc)

lemma sumRes:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  shows "x>(P  Q) s x>P  x>Q"
proof(auto simp add: substClosed_def)
  fix s :: "(name × name) list"

  have "c::name. c  (P, Q, s)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshQ: "c  Q" and cFreshs: "c  s"
    by(force simp add: fresh_prod)

  have "x>(P  Q) = c>(([(x, c)]  P)  ([(x, c)]  Q))"
  proof -
    from cFreshP cFreshQ have "c  P  Q" by simp
    hence "x>(P  Q) = c>([(x, c)]  (P  Q))" by(simp add: alphaRes)
    thus ?thesis by(simp add: name_fresh_fresh)
  qed

  moreover from cFreshP have "x>P = c>([(x, c)]  P)" by(simp add: alphaRes)
  moreover from cFreshQ have "x>Q = c>([(x, c)]  Q)" by(simp add: alphaRes)
  
  ultimately show "(x>(P  Q))[<s>]  (x>P)[<s>]  (x>Q)[<s>]" using cFreshs
    by(force intro: Strong_Late_Bisim_SC.sumRes)
qed

lemma scopeExtSum:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes xFreshP: "x  P"

  shows "x>(P  Q) s P  x>Q"
proof(auto simp add: substClosed_def)
  fix s :: "(name × name) list"

  have "c::name. c  (P, Q, s)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshQ: "c  Q" and cFreshs: "c  s"
    by(force simp add: fresh_prod)

  have "x>(P  Q) = c>(P  ([(x, c)]  Q))"
  proof -
    from cFreshP cFreshQ have "c  P  Q" by simp
    hence "x>(P  Q) = c>([(x, c)]  (P  Q))" by(simp add: alphaRes)
    with xFreshP cFreshP show ?thesis by(simp add: name_fresh_fresh)
  qed

  moreover from cFreshQ have "x>Q = c>([(x, c)]  Q)" by(simp add: alphaRes)
  
  ultimately show "(x>(P  Q))[<s>]  P[<s>]  (x>Q)[<s>]" using cFreshs cFreshP
    by(force intro: Strong_Late_Bisim_SC.scopeExtSum)
qed

lemma parZero:
  fixes P :: pi
  
  shows "P  𝟬 s P"
by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.parZero)

lemma parSym:
  fixes P :: pi
  and   Q :: pi

  shows "P  Q s Q  P"
by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.parSym)

lemma parAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  shows "(P  Q)  R s P  (Q  R)"
  by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.parAssoc)

lemma scopeExtPar:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes xFreshP: "x  P"

  shows "x>(P  Q) s P  x>Q"
proof(auto simp add: substClosed_def)
  fix s :: "(name × name) list"

  have "c::name. c  (P, Q, s)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshQ: "c  Q" and cFreshs: "c  s"
    by(force simp add: fresh_prod)

  have "x>(P  Q) = c>(P  ([(x, c)]  Q))"
  proof -
    from cFreshP cFreshQ have "c  P  Q" by simp
    hence "x>(P  Q) = c>([(x, c)]  (P  Q))" by(simp add: alphaRes)
    with xFreshP cFreshP show ?thesis by(simp add: name_fresh_fresh)
  qed

  moreover from cFreshQ have "x>Q = c>([(x, c)]  Q)" by(simp add: alphaRes)
  
  ultimately show "(x>(P  Q))[<s>]  P[<s>]  (x>Q)[<s>]" using cFreshs cFreshP
    by(force intro: Strong_Late_Bisim_SC.scopeExtPar)
qed

lemma scopeExtPar':
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes xFreshP: "x  Q"

  shows "x>(P  Q) s (x>P)  Q"
proof -
  have "x>(P  Q) s x>(Q  P)" by(blast intro: parSym resPres)
  moreover from xFreshP have "x>(Q  P) s Q  x>P" by(rule scopeExtPar)
  moreover have "Q  x>P s (x>P)  Q" by(rule parSym)
  ultimately show ?thesis by (blast intro: transitive)
qed

lemma bangSC:
  fixes P :: pi

  shows "!P s P  !P"
by(auto simp add: substClosed_def intro: Strong_Late_Bisim_SC.bangSC)

lemma nilRes:
  fixes x :: name
  
  shows "x>𝟬 s 𝟬"
proof(auto simp add: substClosed_def)
  fix σ::"(name × name) list"
  obtain y::name where "y  σ"
    by(generate_fresh "name") auto
  have "y>𝟬  𝟬" by (rule Strong_Late_Bisim_SC.nilRes)
  with y  σ have "(y>𝟬)[<σ>]  𝟬" by simp
  thus "(x>𝟬)[<σ>]  𝟬"
    by(subst alphaRes[where c=y]) auto
qed

lemma resTau:
  fixes x :: name
  and   P :: pi

  shows "x>(τ.(P)) s τ.(x>P)"
proof(auto simp add: substClosed_def)
  fix σ::"(name × name) list"
  obtain y::name where "y  P" and "y  σ"
    by(generate_fresh "name", auto)
  have "y>(τ.(([(x, y)]  P)[<σ>]))  τ.(y>(([(x, y)]  P)[<σ>]))"
    by(rule resTau)
  with y  σ have "(y>(τ.([(x, y)]  P)))[<σ>]  (τ.(y>([(x, y)]  P)))[<σ>]"
    by simp
  with y  P show "(x>τ.(P))[<σ>]  τ.((x>P)[<σ>])"
    apply(subst alphaRes[where c=y])
    apply simp
    apply(subst alphaRes[where c=y and a=x])
    by simp+
qed

lemma resOutput:
  fixes x :: name
  and   a :: name
  and   b :: name
  and   P :: pi

  assumes "x  a"
  and     "x  b"

  shows "x>(a{b}.(P)) s a{b}.(x>P)"
proof(auto simp add: substClosed_def)
  fix σ::"(name × name) list"
  obtain y::name where "y  P" and "y  σ" and "y  a" and "y  b"
    by(generate_fresh "name", auto)
  have "y>((seq_subst_name a σ){seq_subst_name b σ}.(([(x, y)]  P)[<σ>]))  seq_subst_name a σ{seq_subst_name b σ}.(y>(([(x, y)]  P)[<σ>]))"
    using y  a y  b y  σ freshSeqSubstName
    by(rule_tac resOutput) auto
  with y  σ have "(y>(a{b}.([(x, y)]  P)))[<σ>]  (a{b}.(y>([(x, y)]  P)))[<σ>]"
    by simp
  with y  P y  a y  b x  a x  b show "(x>a{b}.(P))[<σ>]  seq_subst_name a σ{seq_subst_name b σ}.((x>P)[<σ>])"
    apply(subst alphaRes[where c=y])
    apply simp
    apply(subst alphaRes[where c=y and a=x])
    by simp+
qed

lemma resInput:
  fixes x :: name
  and   a :: name
  and   b :: name
  and   P :: pi

  assumes "x  a"
  and     "x  y"

  shows "x>(a<y>.(P)) s a<y>.(x>P)"
proof(auto simp add: substClosed_def)
  fix σ::"(name × name) list"
  obtain x'::name where "x'  P" and "x'  σ" and "x'  a" and "x'  x" and "x'  y"
    by(generate_fresh "name", auto)
  obtain y'::name where "y'  P" and "y'  σ" and "y'  a" and "y'  x" and "y'  y" and "x'  y'"
    by(generate_fresh "name", auto)
  have "x'>((seq_subst_name a σ)<y'>.(([(y, y')]  [(x, x')]  P)[<σ>]))  seq_subst_name a σ<y'>.(x'>(([(y, y')]  [(x, x')]  P)[<σ>]))"
    using x'  a x'  y' x'  σ y'  σ freshSeqSubstName
    by(rule_tac resInput) auto
  with x'  σ y'  σ have "(x'>(a<y'>.([(y, y')]  [(x, x')]  P)))[<σ>]  (a<y'>.(x'>([(y, y')]  [(x, x')]  P)))[<σ>]"
    by simp
  with x'  P y'  x x'  y y'  P x'  y' x'  a y'  a x  a x  y show "(x>a<y>.(P))[<σ>]  a<y>.(x>P)[<σ>]"
    apply(subst alphaInput[where c=y'])
    apply simp
    apply(subst alphaRes[where c=x'])
    apply(simp add: abs_fresh fresh_left calc_atm)
    apply(simp add: eqvts calc_atm)
    apply(subst alphaRes[where c=x' and a=x])
    apply simp
    apply(subst alphaInput[where c=y' and x=y])
    apply(simp add: abs_fresh fresh_left calc_atm)
    apply(simp add: eqvts calc_atm)
    apply(subst perm_compose)
    by(simp add: eqvts calc_atm)
qed

lemma bisimSubstStructCong:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"
  shows "P s Q"

using assms
apply(induct rule: structCong.induct)
by(auto intro: reflexive symmetric transitive sumSym sumAssoc sumZero parSym parAssoc parZero
               nilRes resComm resInput resOutput resTau sumRes scopeExtPar bangSC matchId mismatchId)


end

Theory Weak_Late_Cong_Subst_SC

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Cong_Subst_SC
  imports Weak_Late_Cong_Subst Strong_Late_Bisim_Subst_SC
begin

(******** Structural Congruence **********)

(******** The ν-operator *****************)

lemma resComm:
  fixes P :: pi
  
  shows "a>b>P s b>a>P"
proof -
  have "a>b>P s b>a>P"
    by(rule Strong_Late_Bisim_Subst_SC.resComm)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** Match *********)

lemma matchId:
  fixes a :: name
  and   P :: pi

  shows "[aa]P s P"
proof -
  have "[aa]P s P" by(rule Strong_Late_Bisim_Subst_SC.matchId)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** Mismatch *********)

lemma matchNil:
  fixes a :: name
  and   P :: pi

  shows "[aa]P s 𝟬"
proof -
  have "[aa]P s 𝟬" by(rule Strong_Late_Bisim_Subst_SC.mismatchNil)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** The +-operator *********)

lemma sumSym:
  fixes P :: pi
  and   Q :: pi
  
  shows "P  Q s Q  P"
proof -
  have "P  Q s Q  P" by(rule Strong_Late_Bisim_Subst_SC.sumSym)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma sumAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  shows "(P  Q)  R s P  (Q  R)"
proof -
  have "(P  Q)  R s P  (Q  R)" by(rule Strong_Late_Bisim_Subst_SC.sumAssoc)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma sumZero:
  fixes P :: pi
  
  shows "P  𝟬 s P"
proof -
  have "P  𝟬 s P" by(rule Strong_Late_Bisim_Subst_SC.sumZero)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** The |-operator *********)

lemma parZero:
  fixes P :: pi

  shows "P  𝟬 s P"
proof -
  have "P  𝟬 s P" by(rule Strong_Late_Bisim_Subst_SC.parZero)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma parSym:
  fixes P :: pi
  and   Q :: pi

  shows "P  Q s Q  P"
proof -
  have "P  Q s Q  P" by(rule Strong_Late_Bisim_Subst_SC.parSym)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma scopeExtPar:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x  P"

  shows "x>(P  Q) s P  x>Q"
proof -
  from assms have "x>(P  Q) s P  x>Q" by(rule Strong_Late_Bisim_Subst_SC.scopeExtPar)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma scopeExtPar':
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes xFreshQ: "x  Q"

  shows "x>(P  Q) s (x>P)  Q"
proof -
  from assms have "x>(P  Q) s (x>P)  Q" by(rule Strong_Late_Bisim_Subst_SC.scopeExtPar')
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma parAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  shows "(P  Q)  R s P  (Q  R)"
proof -
  have "(P  Q)  R s P  (Q  R)" by(rule Strong_Late_Bisim_Subst_SC.parAssoc)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma scopeFresh:
  fixes P :: pi
  and   a :: name

  assumes aFreshP: "a  P"

  shows "a>P s P"
proof -
  from assms have "a>P s P" by(rule Strong_Late_Bisim_Subst_SC.scopeFresh)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma scopeExtSum:
  fixes P :: pi
  and   Q :: pi
  and   x :: name
  
  assumes "x  P"

  shows "x>(P  Q) s P  x>Q"
proof -
  from assms have "x>(P  Q) s P  x>Q" by(rule Strong_Late_Bisim_Subst_SC.scopeExtSum)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma bangSC:
  fixes P

  shows "!P s P  !P"
proof -
  have "!P s P  !P" by(rule Strong_Late_Bisim_Subst_SC.bangSC)
  thus ?thesis by(rule strongEqWeakCong)
qed

end

Theory Weak_Late_Step_Sim_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Step_Sim_Pres
  imports Weak_Late_Step_Sim
begin

lemma tauPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "τ.(P) ↝<Rel> τ.(Q)"
proof(induct rule: simCases)
  case(Bound Q' a y)
  have "τ.(Q) ay>  Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Input Q' a x)
  have "τ.(Q) a<x>  Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Free Q' α)
  have "τ.(Q)  α  Q'" by fact
  thus ?case using PRelQ
  proof(induct rule: tauCases, auto simp add: pi.inject residual.inject)
    have "τ.(P) lτ  P" by(rule Weak_Late_Step_Semantics.Tau)
    moreover assume "(P, Q')  Rel"
    ultimately show "P'. τ.(P) lτ  P'  (P', Q')  Rel" by blast
  qed
qed

lemma inputPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   x    :: name
  and   Rel  :: "(pi × pi) set"

  assumes PRelQ: "y. (P[x::=y], Q[x::=y])  Rel"
  and     Eqvt: "eqvt Rel"

  shows "a<x>.P ↝<Rel> a<x>.Q"
proof -
  show ?thesis using Eqvt
  proof(induct rule: simCasesCont[of _ "(P, a, x, Q)"])
    case(Bound Q' b y)
    have "a<x>.Q by>  Q'" by fact
    hence False by auto
    thus ?case by simp
  next
    case(Input Q' b y)
    have "y  (P, a, x, Q)" by fact
    hence yFreshP: "(y::name)  P" and yineqx: "y  x" and "y  a" and "y  Q"
      by(simp add: fresh_prod)+
    have "a<x>.Q b<y>  Q'" by fact
    thus ?case using y  a y  x y  Q
    proof(induct rule: inputCases, auto simp add: subject.inject)
      have "u. P'. a<x>.P lu in ([(x, y)]  P)a<y>  P'  (P', ([(x, y)]  Q)[y::=u])  Rel"
      proof(rule allI)
        fix u
        have "a<x>.P lu in ([(x, y)]  P)a<y>  ([(x, y)]  P)[y::=u]" (is "?goal")
        proof -
          from yFreshP have "a<x>.P = a<y>.([(x, y)]  P)" by(rule Agent.alphaInput)
          moreover have "a<y>.([(x, y)]  P) lu in ([(x, y)]  P)a<y>  ([(x, y)]  P)[y::=u]" 
            by(rule Weak_Late_Step_Semantics.Input)
          ultimately show ?goal by(simp add: name_swap)
        qed

        moreover have "(([(x, y)]  P)[y::=u], ([(x, y)]  Q)[y::=u])  Rel"
        proof -
          from PRelQ have "(P[x::=u], Q[x::=u])  Rel" by auto
          with y  P y  Q show ?thesis by(simp add: renaming)
        qed
        
        ultimately show "P'. a<x>.P lu in ([(x, y)]  P)a<y>  P'  (P', ([(x, y)]  Q)[y::=u])  Rel" 
          by blast
      qed
      
      thus "P''. u. P'. a<x>.P lu in P''a<y>  P'  (P', ([(x, y)]  Q)[y::=u])  Rel" by blast
    qed
  next
    case(Free Q' α)
    have "a<x>.Q α  Q'" by fact
    hence False by auto
    thus ?case by simp
  qed
qed

lemma outputPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "a{b}.P ↝<Rel> a{b}.Q"
proof(induct rule: simCases)
  case(Bound Q' c x)
  have "a{b}.Q cx>  Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Input Q' c x)
  have "a{b}.Q c<x>  Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Free Q' α)
  have "a{b}.Q α  Q'" by fact
  thus ?case using PRelQ
  proof(induct rule: outputCases, auto simp add: pi.inject residual.inject)
    have "a{b}.P la[b]  P" by(rule Weak_Late_Step_Semantics.Output)
    moreover assume "(P, Q')  Rel"
    ultimately show "P'. a{b}.P la[b]  P'  (P', Q')  Rel" by blast
  qed
qed

lemma matchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝<Rel> Q"
  and     RelRel': "Rel  Rel'"

  shows "[ab]P ↝<Rel'> [ab]Q"
proof(induct rule: simCases)
  case(Bound Q' c x)
  have "x  [ab]P" by fact
  hence xFreshP: "(x::name)  P" by simp
  have "[ab]Q  cx>  Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case cMatch
    have "Q cx>  Q'" by fact
    with PSimQ xFreshP obtain P' where PTrans: "P lcx>  P'"
                                   and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans have "[aa]P lcx>  P'" by(rule Weak_Late_Step_Semantics.Match)
    moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by blast
    ultimately show ?case by blast
  qed
next
  case(Input Q' c x)
  have "x  [ab]P" by fact
  hence xFreshP: "(x::name)  P" by simp
  have "[ab]Q c<x>  Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case cMatch
    have "Q  c<x>  Q'" by fact
    with PSimQ xFreshP obtain P'' where L1: "u. P'. P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel"
      by(blast dest: simE)
    have "u. P'. [aa]P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel'"
    proof(rule allI)
      fix u
      from L1 obtain P' where PTrans: "P lu in P''c<x>  P'" and P'RelQ': "(P', Q'[x::=u])  Rel"
        by blast
      from PTrans have "[aa]P lu in P''c<x>  P'" by(rule Weak_Late_Step_Semantics.Match)
      with P'RelQ' RelRel' show "P'. [aa]P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel'"
        by blast
    qed
    thus ?case by blast
  qed
next
  case(Free Q' α)
  have "[ab]Q α  Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case cMatch
    have "Q α  Q'" by fact
    with PSimQ obtain P' where PTrans: "P lα  P'" and PRel: "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans have "[aa]P lα  P'" by(rule Weak_Late_Step_Semantics.Match)
    with PRel RelRel' show ?case by blast
  qed
qed

lemma mismatchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝<Rel> Q"
  and     RelRel': "Rel  Rel'"

  shows "[ab]P ↝<Rel'> [ab]Q"
proof(cases "a=b")
  assume "a=b"
  thus ?thesis
    by(auto simp add: weakStepSimDef)
next
  assume aineqb: "ab"
  show ?thesis
  proof(induct rule: simCases)
    case(Bound Q' c x)
    have "x  [ab]P" by fact
    hence xFreshP: "(x::name)  P" by simp
    have "[ab]Q  cx>  Q'" by fact
    thus ?case
    proof(induct rule: mismatchCases)
      case cMismatch
      have "Q cx>  Q'" by fact
      with PSimQ xFreshP obtain P' where PTrans: "P lcx>  P'"
                                     and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans aineqb have "[ab]P lcx>  P'" by(rule Weak_Late_Step_Semantics.Mismatch)
      moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by blast
      ultimately show ?case by blast
    qed
  next
    case(Input Q' c x)
    have "x  [ab]P" by fact
    hence xFreshP: "(x::name)  P" by simp
    have "[ab]Q c<x>  Q'" by fact
    thus ?case
    proof(induct rule: mismatchCases)
      case cMismatch
      have "Q  c<x>  Q'" by fact
      with PSimQ xFreshP obtain P'' where L1: "u. P'. P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel"
        by(blast dest: simE)
      have "u. P'. [ab]P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel'"
      proof(rule allI)
        fix u
        from L1 obtain P' where PTrans: "P lu in P''c<x>  P'" and P'RelQ': "(P', Q'[x::=u])  Rel"
          by blast
        from PTrans aineqb have "[ab]P lu in P''c<x>  P'" by(rule Weak_Late_Step_Semantics.Mismatch)
        with P'RelQ' RelRel' show "P'. [ab]P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel'"
          by blast
      qed
      thus ?case by blast
    qed
  next
    case(Free Q' α)
    have "[ab]Q α  Q'" by fact
    thus ?case
    proof(induct rule: mismatchCases)
      case cMismatch
      have "Q α  Q'" by fact
      with PSimQ obtain P' where PTrans: "P lα  P'" and PRel: "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans a  b have "[ab]P lα  P'" by(rule Weak_Late_Step_Semantics.Mismatch)
      with PRel RelRel' show ?case by blast
    qed
  qed
qed

lemma sumCompose:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  and   T :: pi

  assumes PSimQ: "P ↝<Rel> Q"
  and     RSimT: "R ↝<Rel> T"
  and     RelRel': "Rel  Rel'"

  shows "P  R ↝<Rel'> Q  T"
proof(induct rule: simCases)
  case(Bound Q' a x)
  have "x  P  R" by fact
  hence xFreshP: "(x::name)  P" and xFreshR: "x  R" by simp+
  have "Q  T ax>  Q'" by fact
  thus ?case
  proof(induct rule: sumCases)
    case cSum1
    have "Q ax>  Q'" by fact
    with xFreshP PSimQ obtain P' where PTrans: "P lax>  P'" and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans have "P  R lax>  P'" by(rule Weak_Late_Step_Semantics.Sum1)
    moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by blast
    ultimately show ?case by blast
  next
    case cSum2
    have "T ax>  Q'" by fact
    with xFreshR RSimT obtain R' where RTrans: "R lax>  R'" and R'RelQ': "(R', Q')  Rel"
      by(blast dest: simE)
    from RTrans have "P  R lax>  R'" by(rule Weak_Late_Step_Semantics.Sum2)
    moreover from R'RelQ' RelRel' have "(R', Q')  Rel'" by blast
    ultimately show ?thesis by blast
  qed
next
  case(Input Q' a x)
  have "x  P  R" by fact
  hence xFreshP: "(x::name)  P" and xFreshR: "x  R" by simp+
  have "Q  T a<x>  Q'" by fact
  thus ?case
  proof(induct rule: sumCases)
    case cSum1
    have "Q a<x>  Q'" by fact
    with xFreshP PSimQ obtain P'' where L1: "u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel"
      by(blast dest: simE)
    have "u. P'. P  R lu in P''a<x>  P'  (P', Q'[x::=u])  Rel'"
    proof(rule allI)
      fix u
      from L1 obtain P' where PTrans: "P lu in P''a<x>  P'"
                          and P'RelQ': "(P', Q'[x::=u])  Rel" by blast
      from PTrans have "P  R lu in P''a<x>  P'" by(rule Weak_Late_Step_Semantics.Sum1)
      with P'RelQ' RelRel' show "P'. P  R lu in P''a<x>  P'  (P', Q'[x::=u])  Rel'" by blast
    qed
    thus ?case by blast
  next
    case cSum2
    have "T a<x>  Q'" by fact
    with xFreshR RSimT obtain R'' where L1: "u. R'. R lu in R''a<x>  R'  (R', Q'[x::=u])  Rel" 
      by(blast dest: simE)
    have "u. P'. P  R lu in R''a<x>  P'  (P', Q'[x::=u])  Rel'"
    proof(rule allI)
      fix u
      from L1 obtain R' where RTrans: "R lu in R''a<x>  R'"
                          and R'RelQ': "(R', Q'[x::=u])  Rel" by blast
      from RTrans have "P  R lu in R''a<x>  R'" by(rule Weak_Late_Step_Semantics.Sum2)
      with R'RelQ' RelRel' show  "P'. P  R lu in R''a<x>  P'  (P', Q'[x::=u])  Rel'" by blast
    qed    
    thus ?case by blast
  qed
next
  case(Free Q' α)
  have "Q  T α  Q'" by fact
  thus ?case
  proof(induct rule: sumCases)
    case cSum1
    have "Q α  Q'" by fact
    with PSimQ obtain P' where PTrans: "P lα  P'" and PRel: "(P', Q')  Rel" 
      by(blast dest: simE)
    from PTrans have "P  R lα  P'" by(rule Weak_Late_Step_Semantics.Sum1)
    with RelRel' PRel show ?case by blast
  next
    case cSum2
    have "T α  Q'" by fact
    with RSimT obtain R' where RTrans: "R lα  R'" and RRel: "(R', Q')  Rel" 
      by(blast dest: simE)
    from RTrans have "P  R lα  R'" by(rule Weak_Late_Step_Semantics.Sum2)
    with RelRel' RRel show ?case by blast
  qed
qed
      
lemma sumPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes PSimQ: "P ↝<Rel> Q"
  and     Id: "Id  Rel"
  and     RelRel': "Rel  Rel'"

  shows "P  R ↝<Rel'> Q  R"
proof -
  from Id have Refl: "R ↝<Rel> R" by(rule reflexive)
  from PSimQ Refl RelRel' show ?thesis by(rule sumCompose)
qed

lemma parPres:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  
  assumes PSimQ:    "P ↝<Rel> Q"
  and     PRelQ:    "(P, Q)  Rel"
  and     Par:      "P Q R. (P, Q)  Rel  (P  R, Q  R)  Rel'"
  and     Res:      "P Q a. (P, Q)  Rel'  (a>P, a>Q)  Rel'"
  and     EqvtRel:  "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "P  R ↝<Rel'> Q  R"
using EqvtRel'
proof(induct rule: simCasesCont[where C="(P, Q, R)"])
  case(Bound Q' a x)
  have "x  (P, Q, R)" by fact
  hence xFreshP: "x  P" and xFreshR: "x  R" and "x  Q" by simp+
  from Q  R  ax>  Q' x  Q x  R show ?case
  proof(induct rule: parCasesB)
    case(cPar1 Q')
    have QTrans: "Q  ax>  Q'" by fact
      
    from xFreshP PSimQ QTrans obtain P' where PTrans:"P l ax>  P'"
                                          and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans xFreshR have "P  R l ax>  (P'  R)" by(rule Weak_Late_Step_Semantics.Par1B)
    moreover from P'RelQ' have "(P'  R, Q'  R)  Rel'" by(rule Par)
    ultimately show ?case by blast
  next
    case(cPar2 R')
    have RTrans: "R  ax>  R'" by fact
    hence "R l ax>  R'"
      by(auto simp add: weakTransition_def dest: Weak_Late_Step_Semantics.singleActionChain)
    with xFreshP xFreshR have ParTrans: "P  R lax>  P  R'"
      by(blast intro: Weak_Late_Step_Semantics.Par2B)
    moreover from PRelQ  have "(P  R', Q   R')  Rel'" by(rule Par)
    ultimately show ?case by blast
  qed
next
  case(Input Q' a x)
  have "x  (P, Q, R)" by fact
  hence xFreshP: "x  P" and xFreshR: "x  R" and "x  Q" by simp+
  from Q  R a<x>  Q' x  Q x  R
  show ?case
  proof(induct rule: parCasesB)
    case(cPar1 Q')
    have QTrans: "Q a<x>  Q'" by fact
    from xFreshP PSimQ QTrans obtain P''
      where L1: "u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel" 
      by(blast dest: simE)
    have "u. P'. P  R lu in (P''  R)a<x>  P'  (P', Q'[x::=u]  R[x::=u])  Rel'"
    proof(rule allI)
      fix u
      from L1 obtain P' where PTrans:"P lu in P''a<x>  P'"
                          and P'RelQ': "(P', Q'[x::=u])  Rel" by blast
      from PTrans xFreshR have "P  R lu in (P''  R)a<x>  (P'  R)"
        by(rule Weak_Late_Step_Semantics.Par1B)
      moreover from P'RelQ'  have "(P'  R, Q'[x::=u]  R)  Rel'" 
        by(rule Par)
      ultimately show "P'. P  R lu in (P''  R)a<x>  P'  (P', Q'[x::=u]  (R[x::=u]))  Rel'"
        using xFreshR
        by(force simp add: forget)
    qed
    thus ?case by force
  next
    case(cPar2 R')
    have RTrans: "R a<x>  R'" by fact
    have "u. P'. P  R lu in (P  R')a<x>  P'  (P', Q  R'[x::=u])  Rel'"
    proof 
      fix u
      from RTrans have "R lu in R'a<x>  R'[x::=u]"
        by(rule Weak_Late_Step_Semantics.singleActionChain)
      hence "P  R lu in P  R'a<x>  P  R'[x::=u]" using x  P
        by(rule Weak_Late_Step_Semantics.Par2B)
      moreover from PRelQ have "(P  R'[x::=u], Q   R'[x::=u])  Rel'" by(rule Par)
      ultimately show "P'. P  R lu in (P  R')a<x>  P' 
                           (P', Q  R'[x::=u])  Rel'" by blast
    qed
    thus ?case using x  Q by(fastforce simp add: forget)
  qed
next
  case(Free QR' α)
  have "Q  R  α  QR'" by fact
  thus ?case
  proof(induct rule: parCasesF[of _ _ _ _ _ "(P, R)"])
    case(cPar1 Q')
    have "Q  α  Q'" by fact
    with PSimQ obtain P' where PTrans: "P lα  P'" and PRel: "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans have Trans: "P  R lα  P'  R" by(rule Weak_Late_Step_Semantics.Par1F)
    moreover from PRel have "(P'  R, Q'  R)  Rel'" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cPar2 R')
    have "R  α  R'" by fact
    hence "R lα  R'"
      by(rule Weak_Late_Step_Semantics.singleActionChain)
    hence "P  R lα  (P  R')" by(rule Weak_Late_Step_Semantics.Par2F)
    moreover from PRelQ have "(P  R', Q  R')  Rel'" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cComm1 Q' R' a b x)
    have QTrans: "Q  a<x>  Q'" and RTrans: "R  a[b]  R'" by fact+
    have "x  (P, R)" by fact
    hence xFreshP: "x  P" by(simp add: fresh_prod)
    
    from PSimQ QTrans xFreshP obtain P' P'' where PTrans: "P lb in P''a<x>  P'"
                                              and P'RelQ': "(P', Q'[x::=b])  Rel"
      by(blast dest: simE)
      
    from RTrans have "R la[b]  R'"
      by(rule Weak_Late_Step_Semantics.singleActionChain)
    
    with PTrans have "P  R lτ  P'  R'" by(rule Weak_Late_Step_Semantics.Comm1)
    moreover from P'RelQ' have "(P'  R', Q'[x::=b]  R')  Rel'" by(rule Par)
    ultimately show ?case by blast
  next
    case(cComm2 Q' R' a b x)
    have QTrans: "Q a[b]  Q'" and RTrans: "R a<x>  R'" by fact+
    have "x  (P, R)" by fact
    hence xFreshR: "x  R" by(simp add: fresh_prod)
      
    from PSimQ QTrans obtain P' where PTrans: "P la[b]  P'"
                                  and PRel: "(P', Q')  Rel"
      by(blast dest: simE)
    from RTrans have "R lb in R'a<x>  R'[x::=b]"
      by(rule Weak_Late_Step_Semantics.singleActionChain)
    with PTrans have "P  R lτ  P'  R'[x::=b]" by(rule Weak_Late_Step_Semantics.Comm2)
    moreover from PRel have "(P'  R'[x::=b], Q'  R'[x::=b])  Rel'" by(rule Par)
    ultimately show ?case by blast
  next
    case(cClose1 Q' R' a x y)
    have QTrans: "Q a<x>  Q'" and RTrans: "R ay>  R'" by fact+
    have "x  (P, R)" and "y  (P, R)" by fact+
    hence xFreshP: "x  P" and yFreshR: "y  R" and yFreshP: "y  P" by(simp add: fresh_prod)+
    
    from PSimQ QTrans xFreshP obtain P' P'' where PTrans: "P ly in P''a<x>  P'"
                                              and P'RelQ': "(P', Q'[x::=y])  Rel"
      by(blast dest: simE)
    from RTrans have "R lay>  R'" 
      by(auto simp add: weakTransition_def dest: Weak_Late_Step_Semantics.singleActionChain)
    with PTrans have Trans: "P  R lτ  y>(P'  R')" using yFreshP yFreshR 
      by(rule Weak_Late_Step_Semantics.Close1)
    moreover from P'RelQ' have "(y>(P'  R'), y>(Q'[x::=y]  R'))  Rel'"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  next
    case(cClose2 Q' R' a x y)
    have QTrans: "Q ay>  Q'" and RTrans: "R a<x>  R'" by fact+
    have "x  (P, R)" and "y  (P, R)" by fact+
    hence xFreshR: "x  R" and yFreshP: "y  P" and yFreshR: "y  R" by(simp add: fresh_prod)+

    from PSimQ QTrans yFreshP obtain P' where PTrans: "P lay>  P'"
                                          and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)

    from RTrans have "R ly in R'a<x>  R'[x::=y]"
      by(rule Weak_Late_Step_Semantics.singleActionChain)
    with PTrans have "P  R lτ  y>(P'  R'[x::=y])" using yFreshP yFreshR
      by(rule Weak_Late_Step_Semantics.Close2)
    moreover from P'RelQ' have "(y>(P'  R'[x::=y]), y>(Q'  R'[x::=y]))  Rel'"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  qed
qed

lemma resPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   x    :: name
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝<Rel> Q"
  and     ResRel: "(P::pi) (Q::pi) (x::name). (P, Q)  Rel  (x>P, x>Q)  Rel'"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel: "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "x>P ↝<Rel'> x>Q"
proof -
  from EqvtRel' show ?thesis
  proof(induct rule: simCasesCont[of _ "(P, Q, x)"])
    case(Bound Q' a y)
    have Trans: "x>Q ay>  Q'" by fact
    have "y  (P, Q, x)" by fact
    hence yineqx: "y  x" and yFreshP: "y  P" and "y  Q" by(simp add: fresh_prod)+
    from Trans y  x y  Q show ?case
    proof(induct rule: resCasesB)
      case(cOpen a Q')
      have QTrans: "Q a[x]  Q'" and aineqx: "a  x" by fact+

      from PSimQ QTrans obtain P' where PTrans: "P la[x]  P'"
                                    and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)

      have "x>P lay>  ([(y, x)]  P')"
      proof -
        from PTrans aineqx have "x>P lax>  P'" by(rule Weak_Late_Step_Semantics.Open)
        moreover from PTrans yFreshP have "y  P'" by(force intro: Weak_Late_Step_Semantics.freshTransition)
        ultimately show ?thesis by(simp add: alphaBoundResidual name_swap) 
      qed
      moreover from EqvtRel P'RelQ' RelRel' have "([(y, x)]  P', [(y, x)]  Q')  Rel'"
        by(blast intro: eqvtRelI)
      ultimately show ?case by blast
    next
      case(cRes Q')
      have QTrans: "Q ay>  Q'" by fact
      from x  BoundOutputS a have "x  a" by simp

      from PSimQ yFreshP QTrans obtain P' where PTrans: "P lay>  P'"
                                            and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans x  a yineqx yFreshP have ResTrans: "x>P lay>  (x>P')"
        by(blast intro: Weak_Late_Step_Semantics.ResB)
      moreover from P'RelQ' have "((x>P'), (x>Q'))  Rel'"
        by(rule ResRel)
      ultimately show ?case by blast
    qed
  next
    case(Input Q' a y)
    have "y  (P, Q, x)" by fact
    hence yineqx: "y  x" and yFreshP: "y  P" and "y  Q" by(simp add: fresh_prod)+   
    have "x>Q a<y>  Q'" by fact
    thus ?case using yineqx y  Q
    proof(induct rule: resCasesB)
      case(cOpen a Q')
      thus ?case by simp
    next
      case(cRes Q')
      have QTrans: "Q a<y>  Q'" by fact
      from x  InputS a have "x  a" by simp
      
      from PSimQ QTrans yFreshP obtain P''
        where L1: "u. P'. P lu in P''a<y>  P'  (P', Q'[y::=u])  Rel"
        by(blast dest: simE)
      have "u. P'. x>P lu in (x>P'')a<y>  P'  (P', (x>Q')[y::=u])  Rel'"
      proof(rule allI)
        fix u
        show "P'. x>P lu in x>P''a<y>  P'  (P', (x>Q')[y::=u])  Rel'"
        proof(cases "x=u")
          assume xequ: "x=u"

          have "c::name. c  (P, P'', Q', x, y, a)" by(blast intro: name_exists_fresh)
          then obtain c::name where cFreshP: "c  P" and cFreshP'': "c  P''" and cFreshQ': "c  Q'"
                                and cineqx: "c  x" and cineqy: "c  y" and cineqa: "c  a"
            by(force simp add: fresh_prod)
        
          from L1 obtain P' where PTrans: "P lc in P''a<y>  P'"
                              and P'RelQ': "(P', Q'[y::=c])  Rel"
            by blast
          have "x>P lu in (x>P'')a<y>  c>([(x, c)]  P')"
          proof -
            from PTrans yineqx x  a cineqx have "x>P lc in (x>P'')a<y>  x>P'"
              by(blast intro: Weak_Late_Step_Semantics.ResB)
            hence "([(x, c)]  x>P) l([(x, c)]  c) in ([(x, c)]  x>P'')([(x, c)]  a)<([(x, c)]  y)>  [(x, c)]  x>P'"
              by(rule Weak_Late_Step_Semantics.eqvtI)
            moreover from cFreshP have "c>([(x, c)]  P) = x>P" by(simp add: alphaRes)
            moreover from cFreshP'' have "c>([(x, c)]  P'') = x>P''" by(simp add: alphaRes)
            ultimately show ?thesis using x  a cineqa yineqx cineqy cineqx xequ by(simp add: name_calc)
          qed
          moreover have "(c>([(x, c)]  P'), (x>Q')[y::=u])  Rel'"
          proof -
            from P'RelQ' have "(x>P', x>(Q'[y::=c]))  Rel'" by(rule ResRel)
            with EqvtRel' have "([(x, c)]  x>P', [(x, c)]  x>(Q'[y::=c]))  Rel'"  by(rule eqvtRelI)
            with cineqy yineqx cineqx have "(c>([(x, c)]  P'), (c>([(x, c)]  Q'))[y::=x])  Rel'"
              by(simp add: name_calc eqvt_subs)
            with cFreshQ' xequ show ?thesis by(simp add: alphaRes)
          qed
          ultimately show ?thesis by blast
        next
          assume xinequ: "x  u"
          from L1 obtain P' where PTrans: "P lu in P''a<y>  P'"
                             and P'RelQ': "(P', Q'[y::=u])  Rel" by blast
          
          from PTrans x  a yineqx xinequ have "x>P lu in (x>P'')a<y>  x>P'"
            by(blast intro: Weak_Late_Step_Semantics.ResB)
          moreover from P'RelQ' xinequ yineqx have "(x>P', (x>Q')[y::=u])  Rel'"
            by(force intro: ResRel)
          ultimately show ?thesis by blast
        qed
      qed
      thus ?case by blast
    qed
  next
    case(Free Q' α)
    have "x>Q  α  Q'" by fact
    thus ?case
    proof(induct rule: resCasesF)
      case(cRes Q')
      have "Q α  Q'" by fact
      with PSimQ obtain P' where PTrans: "P lα  P'"
                             and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      
      have "x>P lα  x>P'"
      proof -
        have xFreshAlpha: "x  α" by fact
        with PTrans show ?thesis by(rule Weak_Late_Step_Semantics.ResF)
      qed
      moreover from P'RelQ' have "(x>P', x>Q')  Rel'" by(rule ResRel)
      ultimately show ?case by blast
    qed
  qed
qed

lemma bangPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
 
  assumes PSimQ:    "P ↝<Rel'> Q"
  and     PRelQ:    "(P, Q)  Rel"
  and     Sim:      "P Q. (P, Q)  Rel  P ↝<Rel'> Q"
  and     RelRel':  "P Q. (P, Q)  Rel  (P, Q)  Rel'"
  and     eqvtRel': "eqvt Rel'"

  shows "!P ↝<bangRel Rel'> !Q"
proof -
  from eqvtRel' have EqvtBangRel': "eqvt(bangRel Rel')" by(rule eqvtBangRel)  
  from RelRel' have BRelRel': "P Q. (P, Q)  bangRel Rel  (P, Q)  bangRel Rel'"
    by(auto intro: bangRelSubset)

  have "Rs P. !Q  Rs; (P, !Q)  bangRel Rel  weakStepSimAct P Rs P (bangRel Rel')"
  proof -
    fix Rs P
    assume "!Q  Rs" and "(P, !Q)  bangRel Rel"
    thus "weakStepSimAct P Rs P (bangRel Rel')"
    proof(nominal_induct avoiding: P rule: bangInduct)
      case(cPar1B aa x Q' P)
      have QTrans: "Q aa«x»  Q'" and xFreshQ: "x  Q" by fact+
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        from PRelQ have PSimQ: "P ↝<Rel'> Q" by(rule Sim)
        from EqvtBangRel' show ?case
        proof(induct rule: simActBoundCases)
          case(Input a)
          have "aa = InputS a" by fact
          with PSimQ QTrans xFreshP obtain P''
            where L1: "u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel'"
            by(blast dest: simE)
          have "u. P'. P  R lu in (P''  R)a<x>  P'  (P', (Q'  !Q)[x::=u])  bangRel Rel'"
          proof(rule allI)
            fix u
            from L1 obtain P' where PTrans: "P lu in P''a<x>  P'"
                                and P'RelQ': "(P', Q'[x::=u])  Rel'"
              by blast
            from PTrans xFreshR have "P  R lu in (P''  R)a<x> P'  R"
              by(rule Weak_Late_Step_Semantics.Par1B)
            moreover have "(P'  R, (Q'  !Q)[x::=u])  bangRel Rel'"
            proof -
              from P'RelQ' RBangRelQ have "(P'  R, Q'[x::=u]  !Q)  bangRel Rel'"
                by(blast intro: BRelRel' Rel.BRPar)
              with xFreshQ show ?thesis by(force simp add: forget)
            qed
            ultimately show "P'. P  R lu in (P''  R)a<x>  P' 
                                  (P', (Q'  !Q)[x::=u])  bangRel Rel'"
              by blast
          qed
          thus ?case by blast
        next
          case(BoundOutput a)
          have "aa = BoundOutputS a" by fact
          with PSimQ QTrans xFreshP obtain P' where PTrans: "P lax>  P'" and P'RelQ': "(P', Q')  Rel'"
            by(force dest: simE)
          from PTrans xFreshR have "P  R lax> P'  R"
            by(rule Weak_Late_Step_Semantics.Par1B)
          moreover from P'RelQ' RBangRelQ have "(P'  R, Q'  !Q)  bangRel Rel'"
            by(blast intro: Rel.BRPar BRelRel')
          ultimately show ?case by blast
        qed
      qed
    next
      case(cPar1F α Q' P)
      have QTrans: "Q  α  Q'" by fact
      have "(P, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(induct rule: simActFreeCases)
          case Free
          from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P lα  P'" and P'RelQ': "(P', Q')  Rel'"
            by(blast dest: simE)
        
          from PTrans have "P  R lα  P'  R" by(rule Weak_Late_Step_Semantics.Par1F)
          moreover from P'RelQ' RBangRelQ have "(P'  R, Q'  !Q)  bangRel Rel'"
            by(blast intro: BRelRel' Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cPar2B aa x Q' P)
      have IH: "P. (P, !Q)  bangRel Rel  weakStepSimAct P (aa«x»  Q') P (bangRel Rel')" by fact
      have xFreshQ: "x  Q" by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        from RBangRelQ have IH: "weakStepSimAct R (aa«x»  Q') R (bangRel Rel')" by(rule IH)
        from EqvtBangRel' show ?case
        proof(induct rule: simActBoundCases)
          case(Input a)
          have "aa = InputS a" by fact
          with xFreshR IH obtain  R'' where L1: "u. R'. R lu in R''a<x>  R' 
                                                 (R', Q'[x::=u])  bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)
          have "u. P'. P  R lu in (P  R'')a<x>  P'  (P', (Q  Q')[x::=u])  bangRel Rel'"
          proof(rule allI)
            fix u
            from L1 obtain R' where RTrans: "R lu in R''a<x>  R'"
                                and R'BangRelT': "(R', Q'[x::=u])  bangRel Rel'"
              by blast
            
            from RTrans xFreshP have "P  R lu in (P  R'')a<x>  P  R'"
              by(rule Weak_Late_Step_Semantics.Par2B)
            moreover have "(P  R', (Q  Q')[x::=u])  bangRel Rel'"
            proof -
              from PRelQ R'BangRelT' have "(P  R', Q  Q'[x::=u])  bangRel Rel'"
                by(blast intro: RelRel' Rel.BRPar)
              with xFreshQ show ?thesis by(simp add: forget)
            qed
            ultimately show "P'. P  R lu in (P  R'')a<x>  P'  (P', (Q  Q')[x::=u])  bangRel Rel'"
              by blast
          qed
          thus ?case by blast
        next
          case(BoundOutput a)
          have "aa = BoundOutputS a" by fact
          with IH xFreshR obtain R' where RTrans: "R lax>  R'"
                                      and R'BangRelT': "(R', Q')  bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)

          from RTrans xFreshP have "P  R lax>  P  R'"
            by(auto intro: Weak_Late_Step_Semantics.Par2B)
          moreover from PRelQ R'BangRelT' have "(P  R', Q  Q')  bangRel Rel'"
            by(blast intro: RelRel' Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cPar2F α Q')
      have IH: "P. (P, !Q)  bangRel Rel  weakStepSimAct P (α  Q') P (bangRel Rel')" by fact+
      have "(P, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(induct rule: simActFreeCases)
          case Free
          from RBangRelQ have "weakStepSimAct R (α  Q') R (bangRel Rel')" by(rule IH)
          then obtain R' where RTrans: "R lα  R'" and R'BangRelQ': "(R', Q')  bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)

          from RTrans have "P  R lα  P  R'" by(rule Weak_Late_Step_Semantics.Par2F)
          moreover from PRelQ R'BangRelQ' have "(P  R', Q  Q')  bangRel Rel'"
            by(blast intro: RelRel' Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cComm1 a x Q' b Q'' P)
      have QTrans: "Q  a<x>  Q'" by fact
      have IH: "P. (P, !Q)  bangRel Rel  weakStepSimAct P (a[b]  Q'') P (bangRel Rel')" by fact+
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" by simp
        show ?case
        proof(induct rule: simActFreeCases)
          case Free
          from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
          with QTrans xFreshP obtain P' P'' where PTrans: "P lb in P''a<x>  P'"
                                              and P'RelQ': "(P', Q'[x::=b])  Rel'"
            by(blast dest: simE)
        
          from RBangRelQ have "weakStepSimAct R (a[b]  Q'') R (bangRel Rel')" by(rule IH)
          then obtain R' where RTrans: "R la[b]  R'"
                           and R'RelT': "(R', Q'')  bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)
          from PTrans RTrans have "P  R lτ  (P'  R')"
            by(rule Weak_Late_Step_Semantics.Comm1)
          moreover from P'RelQ' R'RelT' have "(P'  R', Q'[x::=b]  Q'')  bangRel Rel'"
            by(blast intro: RelRel' Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cComm2 a b Q' x Q'' P)
      have QTrans: "Q a[b]  Q'" by fact
      have IH: "P. (P, !Q)  bangRel Rel  weakStepSimAct P (a<x>  Q'') P (bangRel Rel')"
        by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshR: "x  R" by simp
        show ?case
        proof(induct rule: simActFreeCases)
          case Free
          
          from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P la[b]  P'"
                                  and P'RelQ': "(P', Q')  Rel'"
            by(blast dest: simE)
        
          from RBangRelQ have "weakStepSimAct R (a<x>  Q'') R (bangRel Rel')"
            by(rule IH)
          with xFreshR obtain R' R'' where RTrans: "R lb in R''a<x>  R'"
                                       and R'BangRelQ'': "(R', Q''[x::=b])  bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)
        
          from PTrans RTrans have "P  R lτ  (P'  R')"
            by(rule Weak_Late_Step_Semantics.Comm2)
          moreover from P'RelQ' R'BangRelQ'' have "(P'  R', Q'  Q''[x::=b])  bangRel Rel'"
            by(rule Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cClose1 a x Q' y Q'' P)
      have QTrans: "Q  a<x>  Q'" by fact
      have IH: "P. (P, !Q)  bangRel Rel  weakStepSimAct P (ay>  Q'') P (bangRel Rel')"
        by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" and "y  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" and "y  P  R" by fact+
        hence xFreshP: "x  P" and yFreshR: "y  R" and yFreshP: "y  P" by simp+
        show ?case
        proof(induct rule: simActFreeCases)
          case Free
          from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
          with QTrans xFreshP obtain P' P'' where PTrans: "P ly in P''a<x>  P'"
                                              and P'RelQ': "(P', Q'[x::=y])  Rel'"
            by(blast dest: simE)
        
          from RBangRelQ have "weakStepSimAct R (ay>  Q'') R (bangRel Rel')" by(rule IH)
          with yFreshR obtain R' where RTrans: "R lay>  R'"
                                   and R'BangRelQ'': "(R', Q'')  bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)
          from PTrans RTrans yFreshP yFreshR have "P  R lτ  y>(P'  R')"
            by(rule Weak_Late_Step_Semantics.Close1)
          moreover from P'RelQ' R'BangRelQ'' have "(y>(P'  R'), y>(Q'[x::=y]  Q''))  bangRel Rel'"
            by(force intro: Rel.BRPar Rel.BRRes)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cClose2 a y Q' x Q'')
      have QTrans: "Q  ay>  Q'" by fact
      have IH: "P. (P, !Q)  bangRel Rel  weakStepSimAct P (a<x>  Q'') P (bangRel Rel')"
        by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" and "y  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" and "y  P  R" by fact+
        hence xFreshR: "x  R" and yFreshR: "y  R" and yFreshP: "y  P" by simp+
        show ?case
        proof(induct rule: simActFreeCases)
          case Free
          from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
          with QTrans yFreshP obtain P' where PTrans: "P lay>  P'"
                                          and P'RelQ': "(P', Q')  Rel'"
            by(blast dest: simE)

          from RBangRelQ have "weakStepSimAct R (a<x>  Q'') R (bangRel Rel')"
            by(rule IH)
          with xFreshR obtain R' R'' where RTrans: "R ly in R''a<x>  R'"
                                       and R'BangRelT': "(R', Q''[x::=y])  bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)
        
          from PTrans RTrans yFreshP yFreshR have "P  R lτ  y>(P'  R')"
            by(rule Weak_Late_Step_Semantics.Close2)
          moreover from P'RelQ' R'BangRelT' have "(y>(P'  R'), y>(Q'  Q''[x::=y]))  bangRel Rel'"
            by(force intro: Rel.BRPar Rel.BRRes)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cBang Rs)
      have IH: "P. (P, Q  !Q)  bangRel Rel  weakStepSimAct P Rs P (bangRel Rel')"
        by fact
      have "(P, !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRBangCases)
        case(BRBang P)
        have PRelQ: "(P, Q)  Rel" by fact
        hence "(!P, !Q)  bangRel Rel" by(rule Rel.BRBang)
        with PRelQ have "(P  !P, Q  !Q)  bangRel Rel" by(rule Rel.BRPar)
        hence "weakStepSimAct (P  !P) Rs (P  !P) (bangRel Rel')" by(rule IH)
        thus ?case
        proof(simp (no_asm) add: weakStepSimAct_def, auto)
          fix Q' a x
          assume "weakStepSimAct (P  !P) (ax>  Q') (P  !P) (bangRel Rel')" and "x  P"
          then obtain P' where PTrans: "(P  !P) lax>  P'"
                           and P'RelQ': "(P', Q')  (bangRel Rel')"
            by(simp add: weakStepSimAct_def, blast)
          from PTrans have "!P lax>  P'"
            by(rule Weak_Late_Step_Semantics.Bang)
          with P'RelQ' show "P'. !P lax>  P'  (P', Q')  bangRel Rel'" by blast
        next
          fix Q' a x
          assume "weakStepSimAct (P  !P) (a<x>  Q') (P  !P) (bangRel Rel')" and "x  P"
          then obtain P'' where L1: "u. P'. P  !P lu in P''a<x>  P'  (P', Q'[x::=u])  (bangRel Rel')"
            by(simp add: weakStepSimAct_def, blast)
          have "u. P'. !P lu in P''a<x>  P'  (P', Q'[x::=u])  (bangRel Rel')"
          proof(rule allI)
            fix u
            from L1 obtain P' where PTrans: "P  !P lu in P''a<x>  P'"
                                and P'RelQ': "(P', Q'[x::=u])  (bangRel Rel')"
              by blast
            from PTrans have "!P lu in P''a<x>  P'" by(rule Weak_Late_Step_Semantics.Bang)
            with P'RelQ' show "P'. !P lu in P''a<x>  P'  (P', Q'[x::=u])  (bangRel Rel')" by blast
          qed
          thus "P''. u. P'. !P lu in P''a<x>  P'  (P', Q'[x::=u])  (bangRel Rel')" by blast
        next
          fix Q' α
          assume "weakStepSimAct (P  !P) (α  Q') (P  !P) (bangRel Rel')"
          then obtain P' where PTrans: "(P  !P) lα  P'"
                           and P'RelQ': "(P', Q')  (bangRel Rel')"
            by(simp add: weakStepSimAct_def, blast)
          from PTrans have "!P lα  P'"
            by(rule Weak_Late_Step_Semantics.Bang)
          with P'RelQ' show "P'. !P lα  P'  (P', Q')  (bangRel Rel')" by blast
        qed
      qed
    qed
  qed   
  moreover from PRelQ have "(!P, !Q)  bangRel Rel" by(rule Rel.BRBang)
  ultimately show ?thesis by(simp add: weakStepSim_def)
qed

end

Theory Weak_Late_Bisim_SC

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Bisim_SC
  imports Weak_Late_Bisim Strong_Late_Bisim_SC
begin

(******** Structural Congruence **********)

(******** The ν-operator *****************)

lemma resComm:
  fixes P :: pi
  
  shows "a>b>P  b>a>P"
proof -
  have "a>b>P  b>a>P" by(rule Strong_Late_Bisim_SC.resComm)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

(******** Match *********)

lemma matchId:
  fixes a :: name
  and   P :: pi

  shows "[aa]P  P"
proof -
  have "[aa]P  P" by(rule Strong_Late_Bisim_SC.matchId)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

(******** Mismatch *********)

lemma mismatchId:
  fixes a :: name
  and   b :: name
  and   P :: pi

  assumes "a  b"

  shows "[ab]P  P"
proof -
  from assms have "[ab]P  P" by(rule Strong_Late_Bisim_SC.mismatchId)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma mismatchZero:
  fixes a :: name
  and   P :: pi

  shows "[aa]P  𝟬"
proof -
  have "[aa]P  𝟬" by(rule Strong_Late_Bisim_SC.mismatchNil) 
  thus ?thesis by(rule strongBisimWeakBisim)
qed

(******** The +-operator *********)

lemma sumSym:
  fixes P :: pi
  and   Q :: pi
  
  shows "P  Q  Q  P"
proof -
  have "P  Q  Q  P" by(rule Strong_Late_Bisim_SC.sumSym)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma sumAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  shows "(P  Q)  R  P  (Q  R)"
proof -
  have "(P  Q)  R  P  (Q  R)" by(rule Strong_Late_Bisim_SC.sumAssoc)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma sumZero:
  fixes P :: pi
  
  shows "P  𝟬  P"
proof -
  have "P  𝟬  P" by(rule Strong_Late_Bisim_SC.sumZero)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

(******** The |-operator *********)

lemma parZero:
  fixes P :: pi

  shows "P  𝟬  P"
proof -
  have "P  𝟬  P" by(rule Strong_Late_Bisim_SC.parZero)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma parSym:
  fixes P :: pi
  and   Q :: pi

  shows "P  Q  Q  P"
proof -
  have "P  Q  Q  P" by(rule Strong_Late_Bisim_SC.parSym)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma scopeExtPar:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x  P"

  shows "x>(P  Q)  P  x>Q"
proof -
  from assms have "x>(P  Q)  P  x>Q" by(rule Strong_Late_Bisim_SC.scopeExtPar)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma scopeExtPar':
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes xFreshQ: "x  Q"

  shows "x>(P  Q)  (x>P)  Q"
proof -
  from assms have "x>(P  Q)  (x>P)  Q" by(rule Strong_Late_Bisim_SC.scopeExtPar')
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma parAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  shows "(P  Q)  R  P  (Q  R)"
proof -
  have "(P  Q)  R  P  (Q  R)" by(rule Strong_Late_Bisim_SC.parAssoc)
  thus ?thesis by(rule strongBisimWeakBisim)
qed
(*
lemma resZero:
  fixes x :: name

  shows "<νx>𝟬 ≈ 𝟬"
proof -
  have "<νx>𝟬 ∼ 𝟬" by(rule Strong_Late_Bisim_SC.resZero)
  thus ?thesis by(rule strongBisimWeakBisim)
qed
*)
lemma freshRes:
  fixes P :: pi
  and   a :: name

  assumes aFreshP: "a  P"

  shows "a>P  P"
proof -
  from assms have "a>P  P" by(rule Strong_Late_Bisim_SC.scopeFresh)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma scopeExtSum:
  fixes P :: pi
  and   Q :: pi
  and   x :: name
  
  assumes "x  P"

  shows "x>(P  Q)  P  x>Q"
proof -
  from assms have "x>(P  Q)  P  x>Q" by(rule Strong_Late_Bisim_SC.scopeExtSum)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma bangSC:
  fixes P

  shows "!P  P  !P"
proof -
  have "!P  P  !P" by(rule Strong_Late_Bisim_SC.bangSC)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

end

Theory Weak_Late_Sim_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Sim_Pres
  imports Weak_Late_Sim
begin

lemma tauPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "τ.(P) ^<Rel> τ.(Q)"
proof(induct rule: simCases)
  case(Bound Q' a x)
  have "τ.(Q) ax>  Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Input Q' a x)
  have "τ.(Q) a<x>  Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Free Q' α)
  have "τ.(Q) (α  Q')" by fact
  thus ?case using PRelQ
  proof(induct rule: tauCases, auto simp add: pi.inject residual.inject)
    have "τ.(P) l^ τ  P" by(rule Tau)
    moreover assume "(P, Q')  Rel"
    ultimately show "P'. τ.(P) l^ τ  P'  (P', Q')  Rel" by blast
  qed
qed

lemma inputPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   x    :: name
  and   Rel  :: "(pi × pi) set"

  assumes PRelQ: "y. (P[x::=y], Q[x::=y])  Rel"
  and     Eqvt: "eqvt Rel"

  shows "a<x>.P ^<Rel> a<x>.Q"
proof -
  show ?thesis using Eqvt
  proof(induct rule: simCasesCont[of _ "(P, a, x, Q)"])
    case(Bound Q' b y)
    have "a<x>.Q by>  Q'" by fact
    hence False by auto
    thus ?case by simp
  next
    case(Input Q' b y)
    have "y  (P, a, x, Q)" by fact
    hence yFreshP: "(y::name)  P" and yineqx: "y  x" and "y  a" and "y  Q"
      by(simp add: fresh_prod)+
    have "a<x>.Q b<y>  Q'" by fact
    thus ?case using y  a y  x y  Q
    proof(induct rule: inputCases, auto simp add: subject.inject)
      have "u. P'. a<x>.P lu in ([(x, y)]  P)a<y>  P'  (P', ([(x, y)]  Q)[y::=u])  Rel"
      proof(rule allI)
        fix u
        have "a<x>.P lu in ([(x, y)]  P)a<y>  ([(x, y)]  P)[y::=u]" (is "?goal")
        proof -
          from yFreshP have "a<x>.P = a<y>.([(x, y)]  P)" by(rule Agent.alphaInput)
          moreover have "a<y>.([(x, y)]  P) lu in ([(x, y)]  P)a<y>  ([(x, y)]  P)[y::=u]" 
            by(rule Weak_Late_Step_Semantics.Input)
          ultimately show ?goal by(simp add: name_swap)
        qed

        moreover have "(([(x, y)]  P)[y::=u], ([(x, y)]  Q)[y::=u])  Rel"
        proof -
          from PRelQ have "(P[x::=u], Q[x::=u])  Rel" by auto
          with y  P y  Q show ?thesis by(simp add: renaming)
        qed
        
        ultimately show "P'. a<x>.P lu in ([(x, y)]  P)a<y>  P'  (P', ([(x, y)]  Q)[y::=u])  Rel" 
          by blast
      qed
      
      thus "P''. u. P'. a<x>.P lu in P''a<y>  P'  (P', ([(x, y)]  Q)[y::=u])  Rel" by blast
    qed
  next
    case(Free Q' α)
    have "a<x>.Q α  Q'" by fact
    hence False by auto
    thus ?case by simp
  qed
qed

lemma outputPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "a{b}.P ^<Rel> a{b}.Q"
proof(induct rule: simCases)
  case(Bound Q' c x)
  have "a{b}.Q cx>  Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Input Q' c x)
  have "a{b}.Q c<x>  Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Free Q' α)
  have "a{b}.Q α  Q'" by fact
  thus "P'. a{b}.P l^ α  P'  (P', Q')  Rel" using PRelQ
  proof(induct rule: outputCases, auto simp add: pi.inject residual.inject)
    have "a{b}.P l^ a[b]  P" by(rule Output)
    moreover assume "(P, Q')  Rel"
    ultimately show "P'. a{b}.P l^ a[b]  P'  (P', Q')  Rel" by blast
  qed
qed

lemma matchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ^<Rel> Q"
  and     RelStay: "P Q a. (P, Q)  Rel  ([aa]P, Q)  Rel"
  and     RelRel': "Rel  Rel'"

  shows "[ab]P ^<Rel'> [ab]Q"
proof(induct rule: simCases)
  case(Bound Q' c x)
  have "x  [ab]P" by fact
  hence xFreshP: "(x::name)  P" by simp
  have "[ab]Q  cx>  Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case cMatch
    have "Q cx>  Q'" by fact
    with PSimQ xFreshP obtain P' where PTrans: "P l^cx>  P'"
                                   and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans have "[aa]P l^cx>  P'" by(rule Weak_Late_Semantics.Match)
    with P'RelQ' RelRel' show ?case by blast
  qed
next
  case(Input Q' c x)
  have "x  [ab]P" by fact
  hence xFreshP: "x  P" by simp
  have "[ab]Q c<x>  Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case cMatch
    have "Q  c<x>  Q'" by fact
    with PSimQ xFreshP obtain P'' where L1: "u. P'. P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel"
      by(force intro: simE)
    have "u. P'. [aa]P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel'"
    proof(rule allI)
      fix u
      from L1 obtain P' where PTrans: "P lu in P''c<x>  P'" and P'RelQ': "(P', Q'[x::=u])  Rel"
        by blast
      from PTrans have "[aa]P lu in P''c<x>  P'" by(rule Weak_Late_Step_Semantics.Match)
      with P'RelQ' RelRel' show "P'. [aa]P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel'"
        by blast
    qed
    thus ?case by blast
  qed
next
  case(Free Q' α)
  have "[ab]Q  α  Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case cMatch
    have "Q  α  Q'" by fact
    with PSimQ obtain P' where PTrans: "P l^α  P'" and PRel: "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans show ?case
    proof(induct rule: transitionCases)
      case Step
      have "P lα  P'" by fact
      hence "[aa]P lα  P'" by(rule Weak_Late_Step_Semantics.Match)
      with PRel RelRel' show ?case by(force simp add: weakTransition_def)
    next
      case Stay
      have "α  P' = τ  P" by fact
      hence alphaEqTau: "α = τ" and PeqP': "P = P'" by(simp add: residual.inject)+
      have "[aa]P l^τ  [aa]P" by(simp add: weakTransition_def)
      moreover from PeqP' PRel have "([aa]P, Q')  Rel" by(blast intro: RelStay)
      ultimately show ?case using RelRel' alphaEqTau by blast
    qed
  qed
qed

lemma mismatchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ^<Rel> Q"
  and     RelStay: "P Q a b. (P, Q)  Rel; a  b  ([ab]P, Q)  Rel"
  and     RelRel': "Rel  Rel'"

  shows "[ab]P ^<Rel'> [ab]Q"
proof(cases "a = b")
  assume "a = b"
  thus ?thesis by(auto simp add: weakSimulation_def)
next
  assume aineqb: "a  b"
  show ?thesis
  proof(induct rule: simCases)
    case(Bound Q' c x)
    have "x  [ab]P" by fact
    hence xFreshP: "(x::name)  P" by simp
    have "[ab]Q  cx>  Q'" by fact
    thus ?case
    proof(induct rule: mismatchCases)
      case cMismatch
      have "Q cx>  Q'" by fact
      with PSimQ xFreshP obtain P' where PTrans: "P l^cx>  P'"
        and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans aineqb have "[ab]P l^cx>  P'" by(rule Weak_Late_Semantics.Mismatch)
      with P'RelQ' RelRel' show ?case by blast
    qed
  next
    case(Input Q' c x)
    have "x  [ab]P" by fact
    hence xFreshP: "x  P" by simp
    have "[ab]Q c<x>  Q'" by fact
    thus ?case
    proof(induct rule: mismatchCases)
      case cMismatch
      have "Q  c<x>  Q'" by fact
      with PSimQ xFreshP obtain P'' where L1: "u. P'. P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel"
        by(force intro: simE)
      have "u. P'. [ab]P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel'"
      proof(rule allI)
        fix u
        from L1 obtain P' where PTrans: "P lu in P''c<x>  P'" and P'RelQ': "(P', Q'[x::=u])  Rel"
          by blast
        from PTrans aineqb have "[ab]P lu in P''c<x>  P'" by(rule Weak_Late_Step_Semantics.Mismatch)
        with P'RelQ' RelRel' show "P'. [ab]P lu in P''c<x>  P'  (P', Q'[x::=u])  Rel'"
          by blast
      qed
      thus ?case by blast
    qed
  next
    case(Free Q' α)
    have "[ab]Q  α  Q'" by fact
    thus ?case
    proof(induct rule: mismatchCases)
      case cMismatch
      have "a  b" by fact
      have "Q α  Q'" by fact
      with PSimQ obtain P' where PTrans: "P l^α  P'" and PRel: "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans show ?case
      proof(induct rule: transitionCases)
        case Step
        have "P lα  P'" by fact
        hence "[ab]P lα  P'" using a  b by(rule Weak_Late_Step_Semantics.Mismatch)
        with PRel RelRel' show ?case by(force simp add: weakTransition_def)
      next
        case Stay
        have "α  P' = τ  P" by fact
        hence alphaEqTau: "α = τ" and PeqP': "P = P'" by(simp add: residual.inject)+
        have "[ab]P l^τ  [ab]P" by(simp add: weakTransition_def)
        moreover from PeqP' PRel aineqb have "([ab]P, Q')  Rel" by(blast intro: RelStay)
        ultimately show ?case using alphaEqTau RelRel' by blast
      qed
    qed
  qed
qed

lemma parCompose:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   T     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"
  
  assumes PSimQ:    "P ^<Rel> Q"
  and     RSimT:    "R ^<Rel'> T"
  and     PRelQ:    "(P, Q)  Rel"
  and     RRel'T:   "(R, T)  Rel'"
  and     Par:      "P Q R T. (P, Q)  Rel; (R, T)  Rel'  (P  R, Q  T)  Rel''"
  and     Res:      "P Q a. (P, Q)  Rel''  (a>P, a>Q)  Rel''"
  and     EqvtRel:  "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"
  and     EqvtRel'': "eqvt Rel''"

  shows "P  R ^<Rel''> Q  T"
using ‹eqvt Rel''
proof(induct rule: simCasesCont[where C="(P, Q, R, T)"])
  case(Bound Q' a x)
  from x  (P, Q, R, T) have "x  P" and "x  R" and "x  Q" and "x  T" by simp+
  from Q  T  ax>  Q' x  Q x  T
  show ?case
  proof(induct rule: parCasesB)
    case(cPar1 Q')
    from PSimQ Q  ax>  Q' x  P obtain P' where PTrans:"P l^ ax>  P'"
                                                      and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans x  R have "P  R l^ ax>  (P'  R)" by(rule Weak_Late_Semantics.Par1B)
    moreover from P'RelQ' RRel'T have "(P'  R, Q'  T)  Rel''" by(rule Par)
    ultimately show ?case by blast
  next
    case(cPar2 T')
    from RSimT T  ax>  T' x  R obtain R' where RTrans:"R l^ ax>  R'"
                                                      and R'Rel'T': "(R', T')   Rel'"
      by(blast dest: simE)
    from RTrans x  P x  R have ParTrans: "P  R l^ ax>  (P  R')"
      by(blast intro: Weak_Late_Semantics.Par2B)
    moreover from PRelQ R'Rel'T' have "(P  R', Q   T')  Rel''" by(rule Par)
    ultimately show ?case by blast
  qed
next
  case(Input Q' a x)
  from x  (P, Q, R, T) have "x  P" and "x  R" and "x  Q" and "x  T" by simp+
  from Q  T  a<x>  Q' x  Q x  T
  show ?case
  proof(induct rule: parCasesB)
    case(cPar1 Q')
    from PSimQ Q a<x>  Q' x  P obtain P''
      where L1: "u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel" 
      by(blast dest: simE)
    have "u. P'. P  R lu in (P''  R)a<x>  P'  (P', Q'[x::=u]  T[x::=u])  Rel''"
    proof(rule allI)
      fix u
      from L1 obtain P' where PTrans:"P lu in P''a<x>  P'"
                          and P'RelQ': "(P', Q'[x::=u])  Rel" by blast
      from PTrans x  R have "P  R lu in (P''  R)a<x>  (P'  R)"
        by(rule Weak_Late_Step_Semantics.Par1B)
      moreover from P'RelQ' RRel'T have "(P'  R, Q'[x::=u]  T)  Rel''" by(rule Par)
      ultimately show "P'. P  R lu in (P''  R)a<x>  P' 
                            (P', Q'[x::=u]  (T[x::=u]))  Rel''" using x  T
        by(force simp add: forget)
    qed
    thus ?case by force
  next
    case(cPar2 T')
    from RSimT T a<x>  T' x  R obtain R''
      where L1: "u. R'. R lu in R''a<x>  R'  (R', T'[x::=u])  Rel'"
      by(blast dest: simE)
    have "u. P'. P  R lu in (P  R'')a<x>  P'  (P', Q[x::=u]  T'[x::=u])  Rel''"
    proof(rule allI)
      fix u
      from L1 obtain R' where RTrans:"R lu in R''a<x>  R'"
                          and R'Rel'T': "(R', T'[x::=u])   Rel'" by blast
      from RTrans x  P have ParTrans: "P  R lu in (P  R'')a<x>  (P  R')"
        by(rule Weak_Late_Step_Semantics.Par2B)
      
      moreover from PRelQ R'Rel'T' have "(P  R', Q   T'[x::=u])  Rel''" by(rule Par)
      
      ultimately show "P'. P  R lu in (P  R'')a<x>  P' 
                            (P', Q[x::=u]  T'[x::=u])  Rel''" using x  Q
        by(force simp add: forget)
    qed
    thus ?case by force
  qed
next
  case(Free QT' α)
  have "Q  T  α  QT'" by fact
  thus ?case
  proof(induct rule: parCasesF[of _ _ _ _ _ "(P, R)"])
    case(cPar1 Q')
    have "Q  α  Q'" by fact
    with PSimQ obtain P' where PTrans: "P l^ α  P'" and PRel: "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans have Trans: "P  R l^ α  P'  R" by(rule Weak_Late_Semantics.Par1F)
    moreover from PRel RRel'T have "(P'  R, Q'  T)  Rel''" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cPar2 T')
    have "T  α  T'" by fact
    with RSimT obtain R' where RTrans: "R l^ α  R'" and RRel: "(R', T')  Rel'"
      by(blast dest: simE)
    from RTrans have Trans: "P  R l^ α  P  R'" by(rule Weak_Late_Semantics.Par2F)
    moreover from PRelQ RRel have "(P  R', Q  T')  Rel''" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cComm1 Q' T' a b x)
    have QTrans: "Q  a<x>  Q'" and TTrans: "T  a[b]  T'" by fact+
    have "x  (P, R)" by fact
    hence xFreshP: "x  P" by(simp add: fresh_prod)

    from PSimQ QTrans xFreshP obtain P' P'' where PTrans: "P lb in P''a<x>  P'"
                                              and P'RelQ': "(P', Q'[x::=b])  Rel"
      by(blast dest: simE)
      
    from RSimT TTrans obtain R' where RTrans: "R l^a[b]  R'"
                                  and RRel: "(R', T')  Rel'"
      by(blast dest: simE)
      
    from PTrans RTrans have "P  R l^ τ  P'  R'" by(rule Weak_Late_Semantics.Comm1)
    moreover from P'RelQ' RRel have "(P'  R', Q'[x::=b]  T')  Rel''" by(rule Par)
    ultimately show ?case by blast
  next
    case(cComm2 Q' T' a b x)
    have QTrans: "Q a[b]  Q'" and TTrans: "T a<x>  T'" by fact+
    have "x  (P, R)" by fact
    hence xFreshR: "x  R" by(simp add: fresh_prod)
      
    from PSimQ QTrans obtain P' where PTrans: "P l^a[b]  P'"
                                  and PRel: "(P', Q')  Rel"
      by(blast dest: simE)
    
    from RSimT TTrans xFreshR obtain R' R'' where RTrans: "R lb in R''a<x>  R'"
                                              and R'Rel'T': "(R', T'[x::=b])  Rel'"
      by(blast dest: simE)
      
    from PTrans RTrans have "P  R l^ τ  P'  R'" by(rule Weak_Late_Semantics.Comm2)
    moreover from PRel R'Rel'T' have "(P'  R', Q'  T'[x::=b])  Rel''" by(rule Par)
    ultimately show ?case by blast
  next
    case(cClose1 Q' T' a x y)
    have QTrans: "Q a<x>  Q'" and TTrans: "T ay>  T'" by fact+
    have "x  (P, R)" and "y  (P, R)" by fact+
    hence xFreshP: "x  P" and yFreshR: "y  R" and yFreshP: "y  P" by(simp add: fresh_prod)+
      
    from PSimQ QTrans xFreshP obtain P' P'' where PTrans: "P ly in P''a<x>  P'"
                                              and P'RelQ': "(P', Q'[x::=y])  Rel"
      by(blast dest: simE)
      
    from RSimT TTrans yFreshR obtain R' where RTrans: "R l^ay>  R'" 
                                          and R'Rel'T': "(R', T')  Rel'"
      by(blast dest: simE)
      
    from PTrans RTrans yFreshP yFreshR have Trans: "P  R l^ τ  y>(P'  R')"
      by(rule Weak_Late_Semantics.Close1)
    moreover from P'RelQ' R'Rel'T' have "(y>(P'  R'), y>(Q'[x::=y]  T'))  Rel''"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  next
    case(cClose2 Q' T' a x y)
    have QTrans: "Q ay>  Q'" and TTrans: "T a<x>  T'" by fact+
    have "x  (P, R)" and "y  (P, R)" by fact+
    hence xFreshR: "x  R" and yFreshP: "y  P" and yFreshR: "y  R" by(simp add: fresh_prod)+

    from PSimQ QTrans yFreshP obtain P' where PTrans: "P l^ay>  P'"
                                          and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
      
    from RSimT TTrans xFreshR obtain R' R'' where RTrans: "R ly in R''a<x>  R'"
                                              and R'Rel'T': "(R', T'[x::=y])  Rel'"
      by(blast dest: simE)
      
    from PTrans RTrans yFreshP yFreshR have Trans: "P  R l^τ  y>(P'  R')"
      by(rule Weak_Late_Semantics.Close2)
    moreover from P'RelQ' R'Rel'T' have "(y>(P'  R'), y>(Q'  T'[x::=y]))  Rel''"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  qed
qed

lemma parPres:
  fixes P   :: pi
  and   Q   :: pi
  and   R   :: pi
  and   a   :: name
  and   b   :: name
  and   Rel :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"
  
  assumes PSimQ:    "P ^<Rel> Q"
  and     PRelQ:    "(P, Q)  Rel"
  and     Par:      "P Q R. (P, Q)  Rel  (P  R, Q  R)  Rel'"
  and     Res:      "P Q a. (P, Q)  Rel'  (a>P, a>Q)  Rel'"
  and     EqvtRel:  "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "P  R ^<Rel'> Q  R"
proof -
  note PSimQ 
  moreover have RSimR: "R ^<Id> R" by(auto intro: reflexive)
  moreover note PRelQ moreover have "(R, R)  Id" by auto
  moreover from Par have "P Q R T. (P, Q)  Rel; (R, T)  Id  (P  R, Q  T)  Rel'"
    by auto
  moreover note Res ‹eqvt Rel
  moreover have "eqvt Id" by(auto simp add: eqvt_def)
  ultimately show ?thesis using EqvtRel' by(rule parCompose)
qed

lemma resPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   x    :: name
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ^<Rel> Q"
  and     ResRel: "(P::pi) (Q::pi) (x::name). (P, Q)  Rel  (x>P, x>Q)  Rel'"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel: "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "x>P ^<Rel'> x>Q"
proof -
  from EqvtRel' show ?thesis
  proof(induct rule: simCasesCont[of _ "(P, Q, x)"])
    case(Bound Q' a y)
    have Trans: "x>Q ay>  Q'" by fact
    have "y  (P, Q, x)" by fact
    hence yineqx: "y  x" and yFreshP: "y  P" and "y  Q" by(simp add: fresh_prod)+
    from Trans y  x y  Q show ?case
    proof(induct rule: resCasesB)
      case(cOpen a Q')
      have QTrans: "Q a[x]  Q'" and aineqx: "a  x" by fact+

      from PSimQ QTrans obtain P' where PTrans: "P l^a[x]  P'"
                                    and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)

      have "x>P l^ay>  ([(y, x)]  P')"
      proof -
        from PTrans aineqx have "x>P l^ax>  P'" by(rule Weak_Late_Semantics.Open)
        moreover from PTrans yFreshP have "y  P'" by(force intro: freshTransition)
        ultimately show ?thesis by(simp add: alphaBoundResidual name_swap) 
      qed
      moreover from EqvtRel P'RelQ' RelRel' have "([(y, x)]  P', [(y, x)]  Q')  Rel'"
        by(blast intro: eqvtRelI)
      ultimately show ?case by blast
    next
      case(cRes Q')
      have QTrans: "Q ay>  Q'" by fact
      from x  BoundOutputS a have "x  a" by simp

      from PSimQ yFreshP QTrans obtain P' where PTrans: "P l^ay>  P'"
                                            and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans x  a yineqx yFreshP have ResTrans: "x>P l^ay>  (x>P')"
        by(blast intro: Weak_Late_Semantics.ResB)
      moreover from P'RelQ' have "((x>P'), (x>Q'))  Rel'"
        by(rule ResRel)
      ultimately show ?case by blast
    qed
  next
    case(Input Q' a y)
    have "y  (P, Q, x)" by fact
    hence yineqx: "y  x" and yFreshP: "y  P" and "y  Q" by(simp add: fresh_prod)+   
    have "x>Q a<y>  Q'" by fact
    thus ?case using yineqx y  Q
    proof(induct rule: resCasesB)
      case(cOpen a Q')
      thus ?case by simp
    next
      case(cRes Q')
      have QTrans: "Q a<y>  Q'" by fact
      from x  InputS a have "x  a" by simp
      
      from PSimQ QTrans yFreshP obtain P''
        where L1: "u. P'. P lu in P''a<y>  P'  (P', Q'[y::=u])  Rel"
        by(blast dest: simE)
      have "u. P'. x>P lu in (x>P'')a<y>  P'  (P', (x>Q')[y::=u])  Rel'"
      proof(rule allI)
        fix u
        show "P'. x>P lu in x>P''a<y>  P'  (P', (x>Q')[y::=u])  Rel'"
        proof(cases "x=u")
          assume xequ: "x=u"

          have "c::name. c  (P, P'', Q', x, y, a)" by(blast intro: name_exists_fresh)
          then obtain c::name where cFreshP: "c  P" and cFreshP'': "c  P''" and cFreshQ': "c  Q'"
                                and cineqx: "c  x" and cineqy: "c  y" and cineqa: "c  a"
            by(force simp add: fresh_prod)
        
          from L1 obtain P' where PTrans: "P lc in P''a<y>  P'"
                              and P'RelQ': "(P', Q'[y::=c])  Rel"
            by blast
          have "x>P lu in (x>P'')a<y>  c>([(x, c)]  P')"
          proof -
            from PTrans yineqx x  a cineqx have "x>P lc in (x>P'')a<y>  x>P'"
              by(blast intro: Weak_Late_Step_Semantics.ResB)
            hence "([(x, c)]  x>P) l([(x, c)]  c) in ([(x, c)]  x>P'')([(x, c)]  a)<([(x, c)]  y)>  [(x, c)]  x>P'"
              by(rule Weak_Late_Step_Semantics.eqvtI)
            moreover from cFreshP have "c>([(x, c)]  P) = x>P" by(simp add: alphaRes)
            moreover from cFreshP'' have "c>([(x, c)]  P'') = x>P''" by(simp add: alphaRes)
            ultimately show ?thesis using x  a cineqa yineqx cineqy cineqx xequ by(simp add: name_calc)
          qed
          moreover have "(c>([(x, c)]  P'), (x>Q')[y::=u])  Rel'"
          proof -
            from P'RelQ' have "(x>P', x>(Q'[y::=c]))  Rel'" by(rule ResRel)
            with EqvtRel' have "([(x, c)]  x>P', [(x, c)]  x>(Q'[y::=c]))  Rel'"  by(rule eqvtRelI)
            with cineqy yineqx cineqx have "(c>([(x, c)]  P'), (c>([(x, c)]  Q'))[y::=x])  Rel'"
              by(simp add: name_calc eqvt_subs)
            with cFreshQ' xequ show ?thesis by(simp add: alphaRes)
          qed
          ultimately show ?thesis by blast
        next
          assume xinequ: "x  u"
          from L1 obtain P' where PTrans: "P lu in P''a<y>  P'"
                             and P'RelQ': "(P', Q'[y::=u])  Rel" by blast
          
          from PTrans x  a yineqx xinequ have "x>P lu in (x>P'')a<y>  x>P'"
            by(blast intro: Weak_Late_Step_Semantics.ResB)
          moreover from P'RelQ' xinequ yineqx have "(x>P', (x>Q')[y::=u])  Rel'"
            by(force intro: ResRel)
          ultimately show ?thesis by blast
        qed
      qed
      thus ?case by blast
    qed
  next
    case(Free Q' α)
    have "x>Q  α  Q'" by fact
    thus ?case
    proof(induct rule: resCasesF)
      case(cRes Q')
      have "Q α  Q'" by fact
      with PSimQ obtain P' where PTrans: "P l^ α  P'"
                             and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      
      have "x>P l^α  x>P'"
      proof -
        have xFreshAlpha: "x  α" by fact
        with PTrans show ?thesis by(rule ResF)
      qed
      moreover from P'RelQ' have "(x>P', x>Q')  Rel'" by(rule ResRel)
      ultimately show ?case by blast
    qed
  qed
qed

lemma resChainI:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   lst :: "name list"

  assumes eqvtRel: "eqvt Rel"
  and     Res:     "P Q a. (P, Q)  Rel  (a>P, a>Q)  Rel"
  and     PRelQ:   "P ^<Rel> Q"

  shows "(resChain lst) P ^<Rel> (resChain lst) Q"
proof -
  show ?thesis
  proof(induct lst) (* Base case *)
    from PRelQ show "resChain [] P ^<Rel> resChain [] Q" by simp
  next (* Inductive step *)
    fix a lst
    assume IH: "(resChain lst P) ^<Rel> (resChain lst Q)"
    moreover from Res have "P Q a. (P, Q)  Rel  (a>P, a>Q)  Rel"
      by simp
    moreover have "Rel  Rel" by simp
    ultimately have "a>(resChain lst P) ^<Rel> a>(resChain lst Q)" using eqvtRel
      by(rule_tac resPres)
    thus "resChain (a # lst) P ^<Rel> resChain (a # lst) Q"
      by simp
  qed
qed

lemma bangPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
 
  assumes PSimQ:       "P ^<Rel> Q"
  and     PRelQ:       "(P, Q)  Rel"
  and     Sim:         "P Q. (P, Q)  Rel  P ^<Rel> Q"

  and     ParComp:     "P Q R T. (P, Q)  Rel; (R, T)  Rel'  (P  R, Q  T)  Rel'"
  and     Res:         "P Q x. (P, Q)  Rel'  (x>P, x>Q)  Rel'"

  and     RelStay:        "P Q. (P  !P, Q)  Rel'  (!P, Q)  Rel'"
  and     BangRelRel': "(bangRel Rel)  Rel'"
  and     eqvtRel':    "eqvt Rel'"

  shows "!P ^<Rel'> !Q"
proof -
  have "Rs P. !Q  Rs; (P, !Q)  bangRel Rel  weakSimAct P Rs P Rel'"
  proof -
    fix Rs P
    assume "!Q  Rs" and "(P, !Q)  bangRel Rel"
    thus "weakSimAct P Rs P Rel'"
    proof(nominal_induct avoiding: P rule: bangInduct)
      case(cPar1B aa x Q')
      have QTrans: "Q aa«x»  Q'" and xFreshQ: "x  Q" by fact+
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelT: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        from PRelQ have PSimQ: "P ^<Rel> Q" by(rule Sim)
        from eqvtRel' show ?case
        proof(induct rule: simActBoundCases)
          case(Input a)
          have "aa = InputS a" by fact
          with PSimQ QTrans xFreshP obtain P''
            where L1: "u. P'. P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel"
            by(blast dest: simE)
          have "u. P'. P  R lu in (P''  R)a<x>  P'  (P', (Q'  !Q)[x::=u])  Rel'"
          proof(rule allI)
            fix u
            from L1 obtain P' where PTrans: "P lu in P''a<x>  P'"
                                and P'RelQ': "(P', Q'[x::=u])  Rel"
              by blast
            
            from PTrans xFreshR have "P  R lu in (P''  R)a<x> P'  R"
              by(rule Weak_Late_Step_Semantics.Par1B)
            moreover have "(P'  R, (Q'  !Q)[x::=u])  Rel'"
            proof -
              from P'RelQ' RBangRelT have "(P'  R, Q'[x::=u]  !Q)  bangRel Rel"
                by(rule Rel.BRPar)
              with xFreshQ BangRelRel' show ?thesis by(auto simp add: forget)
            qed
            ultimately show "P'. P  R lu in (P''  R)a<x>  P' 
                                  (P', (Q'  !Q)[x::=u])  Rel'" by blast
          qed
          thus ?case by blast
        next
          case(BoundOutput a)
          have "aa = BoundOutputS a" by fact
          with PSimQ QTrans xFreshP obtain P' where PTrans: "P l^ax>  P'"
                                                and P'RelQ': "(P', Q')  Rel"
            by(blast dest: simE)
          from PTrans xFreshR have "P  R l^ax> P'  R"
            by(rule Weak_Late_Semantics.Par1B)
          moreover from P'RelQ' RBangRelT BangRelRel' have "(P'  R, Q'  !Q)  Rel'"
            by(blast intro: Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cPar1F α Q' P)
      have QTrans: "Q α  Q'" by fact
      have "(P, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from PRelQ have "P ^<Rel> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P l^α  P'" and P'RelQ': "(P', Q')  Rel"
            by(blast dest: simE)

          from PTrans have "P  R l^α  P'  R" by(rule Weak_Late_Semantics.Par1F)
          moreover from P'RelQ' RBangRelQ have "(P'  R, Q'  !Q)  bangRel Rel"
            by(rule Rel.BRPar)
          ultimately show ?case using BangRelRel' by blast
        qed
      qed
    next
      case(cPar2B aa x Q' P)
      have IH: "P. (P, !Q)  bangRel Rel  weakSimAct P (aa«x»  Q') P Rel'" by fact
      have xFreshQ: "x  Q" by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        from eqvtRel' show ?case
        proof(induct rule: simActBoundCases)
          case(Input a)
          have "aa = InputS a" by fact
          with RBangRelQ IH have "weakSimAct R (a<x>  Q') R Rel'" by blast
          with xFreshR obtain R'' where L1: "u. R'. R lu in R''a<x>  R'  (R', Q'[x::=u])  Rel'"
            by(force simp add: weakSimAct_def)
          have "u. P'. P  R lu in (P  R'')a<x>  P'  (P', (Q  Q')[x::=u])  Rel'"
          proof(rule allI)
            fix u
            from L1 obtain R' where RTrans: "R lu in R''a<x>  R'"
                                and R'Rel'Q': "(R', Q'[x::=u])  Rel'"
              by blast
            
            from RTrans xFreshP have "P  R lu in (P  R'')a<x>  P  R'"
              by(rule Weak_Late_Step_Semantics.Par2B)
            moreover have "(P  R', (Q  Q')[x::=u])  Rel'"
            proof -
              from PRelQ R'Rel'Q' have "(P  R', Q  Q'[x::=u])  Rel'"
                by(rule ParComp)
              with xFreshQ show ?thesis by(simp add: forget)
            qed
            ultimately show "P'. P  R lu in (P  R'')a<x>  P'  (P', (Q  Q')[x::=u])  Rel'"
              by blast
          qed
          thus ?case by blast
        next
          case(BoundOutput a)
          have "aa = BoundOutputS a" by fact
          with IH RBangRelQ have "weakSimAct R (ax>  Q') R Rel'" by blast
          with xFreshR obtain R' where RTrans: "R l^ax>  R'" and R'BangRelQ': "(R', Q')  Rel'"
            by(simp add: weakSimAct_def, blast)
          
          from RTrans xFreshP have "P  R l^ax>  P  R'"
            by(auto intro: Weak_Late_Semantics.Par2B)
          moreover from PRelQ R'BangRelQ' have "(P  R', Q  Q')  Rel'"
            by(rule ParComp)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cPar2F α Q' P)
      have IH: "P. (P, !Q)  bangRel Rel  weakSimAct P (α  Q') P Rel'" by fact
      have "(P, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from RBangRelQ have "weakSimAct R (α  Q') R Rel'" by(rule IH)
          then obtain R' where RTrans: "R l^α  R'" and R'RelQ': "(R', Q')  Rel'"
            by(simp add: weakSimAct_def, blast)

          from RTrans have "P  R l^α  P  R'" by(rule Weak_Late_Semantics.Par2F)
          moreover from PRelQ R'RelQ' have "(P  R', Q  Q')  Rel'" by(rule ParComp)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cComm1 a x Q' b Q'' P)
      have QTrans: "Q  a<x>  Q'" by fact
      have IH: "P. (P, !Q)  bangRel Rel  weakSimAct P (a[b]  Q'') P Rel'" by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" by simp
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from PRelQ have "P ^<Rel> Q" by(rule Sim)
          with QTrans xFreshP obtain P' P'' where PTrans: "P lb in P''a<x>  P'"
                                              and P'RelQ': "(P', Q'[x::=b])  Rel"
            by(blast dest: simE)

          from RBangRelQ have "weakSimAct R (a[b]  Q'') R Rel'" by(rule IH)
          then obtain R' where RTrans: "R l^a[b]  R'"
                           and R'RelQ'': "(R', Q'')  Rel'"
            by(simp add: weakSimAct_def, blast)
        
          from PTrans RTrans have "P  R l^τ  (P'  R')"
            by(rule Weak_Late_Semantics.Comm1)
          moreover from P'RelQ' R'RelQ'' have "(P'  R', Q'[x::=b]  Q'')  Rel'"
            by(rule ParComp)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cComm2 a b Q' x Q'' P)
      have QTrans: "Q a[b]  Q'" by fact
      have IH: "P. (P, !Q)  bangRel Rel  weakSimAct P (a<x>  Q'') P Rel'" by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshR: "x  R" by simp
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from PRelQ have "P ^<Rel> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P l^a[b]  P'" and P'RelQ': "(P', Q')  Rel"
            by(blast dest: simE)

          from RBangRelQ have "weakSimAct R (a<x>  Q'') R Rel'" by(rule IH)
          with xFreshR obtain R' R'' where RTrans: "R lb in R''a<x>  R'"
                                       and R'BangRelQ'': "(R', Q''[x::=b])  Rel'"
            by(simp add: weakSimAct_def, blast)
        
          from PTrans RTrans have "P  R l^τ  (P'  R')"
            by(rule Weak_Late_Semantics.Comm2)
          moreover from P'RelQ' R'BangRelQ'' have "(P'  R', Q'  Q''[x::=b])  Rel'"
            by(rule ParComp)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cClose1 a x Q' y Q'' P)
      have QTrans: "Q  a<x>  Q'" by fact
      have IH: "P. (P, !Q)  bangRel Rel  weakSimAct P (ay>  Q'') P Rel'" by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" and "y  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" by simp
        have "y  P  R" by fact
        hence yFreshR: "y  R" and yFreshP: "y  P" by simp+
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from PRelQ have "P ^<Rel> Q" by(rule Sim)
          with QTrans xFreshP obtain P' P'' where PTrans: "P ly in P''a<x>  P'"
                                              and P'RelQ': "(P', Q'[x::=y])  Rel"
            by(blast dest: simE)
          
          from RBangRelQ have "weakSimAct R (ay>  Q'') R Rel'" by(rule IH)
          with yFreshR obtain R' where RTrans: "R l^ay>  R'"
                                   and R'RelQ'': "(R', Q'')  Rel'"
            by(simp add: weakSimAct_def, blast)
        
          from PTrans RTrans yFreshP yFreshR have "P  R l^τ  y>(P'  R')"
            by(rule Weak_Late_Semantics.Close1)
          moreover from P'RelQ' R'RelQ'' have "(y>(P'  R'), y>(Q'[x::=y]  Q''))  Rel'"
            by(force intro: ParComp Res)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cClose2 a y Q' x Q'' P)
      have QTrans: "Q  ay>  Q'" by fact
      have IH: "P. (P, !Q)  bangRel Rel  weakSimAct P (a<x>  Q'') P Rel'" by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" and "y  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshR: "x  R" by simp
        have "y  P  R" by fact
        hence yFreshP: "y  P" and yFreshR: "y  R" by simp+
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from PRelQ have "P ^<Rel> Q" by(rule Sim)
          with QTrans yFreshP obtain P' where PTrans: "P l^ay>  P'"
                                          and P'RelQ': "(P', Q')  Rel"
            by(blast dest: simE)

          from RBangRelQ have "weakSimAct R (a<x>  Q'') R Rel'" by(rule IH)
          with xFreshR obtain R' R'' where RTrans: "R ly in R''a<x>  R'"
                                       and R'RelQ'': "(R', Q''[x::=y])  Rel'"
            by(simp add: weakSimAct_def, blast)
        
          from PTrans RTrans yFreshP yFreshR have "P  R l^τ  y>(P'  R')"
            by(rule Weak_Late_Semantics.Close2)
          moreover from P'RelQ' R'RelQ'' have "(y>(P'  R'), y>(Q'  Q''[x::=y]))  Rel'"
            by(force intro: ParComp Res)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cBang Rs)
      have IH: "P. (P, Q  !Q)  bangRel Rel  weakSimAct P Rs P Rel'" by fact
      have "(P, !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRBangCases)
        case(BRBang P)
        have PRelQ: "(P, Q)  Rel" by fact
        hence "(!P, !Q)  bangRel Rel" by(rule Rel.BRBang)
        with PRelQ have "(P  !P, Q  !Q)  bangRel Rel" by(rule Rel.BRPar)
        hence "weakSimAct (P  !P) Rs (P  !P) Rel'" by(rule IH)
        thus ?case
        proof(simp (no_asm) add: weakSimAct_def, auto)
          fix Q' a x
          assume "weakSimAct (P  !P) (ax>  Q') (P  !P) Rel'" and "x  P"
          then obtain P' where PTrans: "(P  !P) l^ax>  P'"
                           and P'RelQ': "(P', Q')  Rel'"
            by(simp add: weakSimAct_def, blast)
          from PTrans have "!P l^ax>  P'"
            by(force intro: Weak_Late_Step_Semantics.Bang simp add: weakTransition_def)
          with P'RelQ' show "P'. !P l^ax>  P'  (P', Q')  Rel'" by blast
        next
          fix Q' a x
          assume "weakSimAct (P  !P) (a<x>  Q') (P  !P) Rel'" and "x  P"
          then obtain P'' where L1: "u. P'. P  !P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel'"
            by(simp add: weakSimAct_def, blast)
          have "u. P'. !P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel'"
          proof(rule allI)
            fix u
            from L1 obtain P' where PTrans: "P  !P lu in P''a<x>  P'"
                                and P'RelQ': "(P', Q'[x::=u])  Rel'"
              by blast
            from PTrans have "!P lu in P''a<x>  P'" by(rule Weak_Late_Step_Semantics.Bang)
            with P'RelQ' show "P'. !P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel'" by blast
          qed
          thus "P''. u. P'. !P lu in P''a<x>  P'  (P', Q'[x::=u])  Rel'" by blast
        next
          fix Q' α
          assume "weakSimAct (P  !P) (α  Q') (P  !P) Rel'"
          then obtain P' where PTrans: "(P  !P) l^α  P'"
                           and P'RelQ': "(P', Q')  Rel'"
            by(simp add: weakSimAct_def, blast)
          from PTrans show "P'. !P l^α  P'  (P', Q')  Rel'"
          proof(induct rule: transitionCases)
            case Step
            have "P  !P lα  P'" by fact
            hence "!P lα  P'" by(rule Weak_Late_Step_Semantics.Bang)
            with P'RelQ' show ?case by(force simp add: weakTransition_def)
          next
            case Stay
            have "α  P' = τ  P  !P" by fact
            hence αeqτ: "α = τ" and P'eqP: "P' = P  !P" by(simp add: residual.inject)+
            have "!P l^τ  !P" by(simp add: weakTransition_def)
            moreover from P'eqP P'RelQ' have "(!P, Q')  Rel'" by(blast intro: RelStay)
            ultimately show ?case using αeqτ by blast
          qed
        qed
      qed
    qed
  qed
  moreover from PRelQ have "(!P, !Q)  bangRel Rel" by(rule Rel.BRBang)
  ultimately show ?thesis by(simp add: simDef)
qed

end

Theory Weak_Late_Bisim_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Bisim_Pres
  imports Weak_Late_Bisim_SC Weak_Late_Sim_Pres Strong_Late_Bisim_SC
begin

lemma tauPres:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"

  shows "τ.(P)  τ.(Q)"
proof -
  let ?X = "{(τ.(P), τ.(Q)) | P Q. P  Q}"
  from assms have "(τ.(P), τ.(Q))  ?X" by auto
  thus ?thesis
    by(coinduct rule: weakBisimCoinduct)
      (auto simp add: pi.inject intro:  Weak_Late_Sim_Pres.tauPres symmetric)
qed

lemma inputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   x :: name

  assumes PSimQ: "y. P[x::=y]  Q[x::=y]"
  
  shows "a<x>.P  a<x>.Q"
proof -
  let ?X = "{(a<x>.P, a<x>.Q) | a x P Q. y. P[x::=y]  Q[x::=y]}"
  {
    fix axP axQ p
    assume "(axP, axQ)  ?X"
    then obtain a x P Q where A: "y. P[x::=y]  Q[x::=y]" and B: "axP = a<x>.P" and C: "axQ = a<x>.Q"
      by auto
    have "y. ((p::name prm)  P)[(p  x)::=y]  (p  Q)[(p  x)::=y]"
    proof -
      fix y
      from A have "P[x::=(rev p  y)]  Q[x::=(rev p  y)]"
        by blast
      hence "(p  (P[x::=(rev p  y)]))  p  (Q[x::=(rev p  y)])"
        by(rule eqvtI)
      thus "(p  P)[(p  x)::=y]  (p  Q)[(p  x)::=y]"
        by(simp add: eqvts pt_pi_rev[OF pt_name_inst, OF at_name_inst])
    qed
    hence "((p::name prm)  axP, p  axQ)  ?X" using B C
      by auto
  }
  hence "eqvt ?X" by(simp add: eqvt_def)

  from PSimQ have "(a<x>.P, a<x>.Q)  ?X" by auto
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim P Q)
    thus ?case using ‹eqvt ?X
      by(force intro: inputPres)
  next
    case(cSym P Q)
    thus ?case
      by(blast dest: symmetric)
  qed
qed

lemma outputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "a{b}.(P)  a{b}.(Q)"
proof -
  let ?X = "{(a{b}.(P), a{b}.(Q)) | a b P Q. P  Q}"
  from assms have "(a{b}.(P), a{b}.(Q))  ?X" by auto
  thus ?thesis
    by(coinduct rule: weakBisimCoinduct)
      (auto simp add: pi.inject intro:  Weak_Late_Sim_Pres.outputPres symmetric)
qed

lemma resPres:
  fixes P :: pi
  and   Q :: pi
  and   x :: name
  
  assumes PBiSimQ: "P  Q"

  shows "x>P  x>Q"
proof -
  let ?X = "{x. P Q. P  Q  (a. x = (a>P, a>Q))}"
  from PBiSimQ have "(x>P, x>Q)  ?X" by blast
  moreover have "P Q a. P ^<weakBisim> Q  a>P ^<(?X  weakBisim)> a>Q"
  proof -
    fix P Q a
    assume PSimQ: "P ^<weakBisim> Q"
    moreover have "P Q a. P  Q  (a>P, a>Q)  ?X  weakBisim" by blast
    moreover have "weakBisim  ?X  weakBisim" by blast
    moreover have "eqvt weakBisim" by(rule eqvt)
    moreover have "eqvt (?X  weakBisim)"
      by(auto simp add: eqvt_def dest: eqvtI)+
    ultimately show "a>P ^<(?X  weakBisim)> a>Q"
      by(rule Weak_Late_Sim_Pres.resPres)
  qed
    
  ultimately show ?thesis using PBiSimQ
    by(coinduct rule: weakBisimCoinductAux, blast dest: unfoldE)
qed

lemma matchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
proof -
  let ?X = "{([ab]P, [ab]Q) | a b P Q. P  Q}"
  from assms have "([ab]P, [ab]Q)  ?X" by auto
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim P Q)
    {
      fix P Q a b
      assume "P  Q"
      hence "P ^<weakBisim> Q" by(rule unfoldE)
      moreover {
        fix P Q a
        assume "P  Q"
        moreover have "[aa]P  P" by(rule matchId)
        ultimately have "[aa]P  Q" by(blast intro: transitive)
      }
      moreover have "weakBisim  ?X  weakBisim" by blast
      ultimately have "[ab]P ^<(?X  weakBisim)> [ab]Q"
        by(rule matchPres)
    }
    with (P, Q)  ?X show ?case by auto
  next
    case(cSym P Q)
    thus ?case by(auto simp add: pi.inject dest: symmetric)
  qed
qed

lemma mismatchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
proof -
  let ?X = "{([ab]P, [ab]Q) | a b P Q. P  Q}"
  from assms have "([ab]P, [ab]Q)  ?X" by auto
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim P Q)
    {
      fix P Q a b
      assume "P  Q"
      hence "P ^<weakBisim> Q" by(rule unfoldE)
      moreover {
        fix P Q a b
        assume "P  Q" and "(a::name)  b"
        note P  Q
        moreover from a  b have "[ab]P  P" by(rule mismatchId)
        ultimately have "[ab]P  Q" by(blast intro: transitive)
      }
      moreover have "weakBisim  ?X  weakBisim" by blast
      ultimately have "[ab]P ^<(?X  weakBisim)> [ab]Q"
        by(rule mismatchPres)
    }
    with (P, Q)  ?X show ?case by auto
  next
    case(cSym P Q)
    thus ?case by(auto simp add: pi.inject dest: symmetric)
  qed
qed

lemma parPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P  Q"

  shows "P  R  Q  R"
proof -
  let ?ParSet = "{(resChain lst (P  R), resChain lst (Q  R)) | lst P Q R. P  Q}"
  have BC: "P Q. P  Q = resChain [] (P  Q)" by auto
  from assms have "(P  R, Q  R)  ?ParSet" by(blast intro: BC)
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim PR QR)
    {
      fix P Q R lst
      assume "P  Q"
    
      from eqvtI have "eqvt (?ParSet  weakBisim)"
        by(auto simp add: eqvt_def, blast)
      moreover have "P Q a. (P, Q)  ?ParSet  weakBisim  (a>P, a>Q)  ?ParSet  weakBisim"
        by(blast intro: resChain.step[THEN sym] resPres)
      moreover {
        from P  Q have "P ^<weakBisim> Q" by(rule unfoldE)
        moreover note P  Q
        moreover {
          fix P Q R
          assume "P  Q"
          moreover have "P  R = resChain [] (P  R)" by simp
          moreover have "Q  R = resChain [] (Q  R)" by simp
          ultimately have "(P  R, Q  R)  ?ParSet  weakBisim" by blast
        }
        moreover {
          fix P Q a
          assume A: "(P, Q)  ?ParSet  weakBisim"
          hence "(a>P, a>Q)  ?ParSet  weakBisim" (is "?goal")
            apply(auto intro: resPres)
            by(rule_tac x="a#lst" in exI) auto
        }
        ultimately have "(P  R) ^<(?ParSet  weakBisim)> (Q  R)" using eqvt ‹eqvt(?ParSet  weakBisim)
          by(rule Weak_Late_Sim_Pres.parPres)
      }

      ultimately have "resChain lst (P  R) ^<(?ParSet  weakBisim)> resChain lst (Q  R)"
        by(rule resChainI)
    }
    with (PR, QR)  ?ParSet show ?case by blast
  next
    case(cSym PR QR)
    thus ?case by(auto dest: symmetric)
  qed
qed

lemma bangPres:
  fixes P :: pi
  and   Q :: pi

  assumes PBisimQ: "P  Q"

  shows "!P  !Q"
proof -
  let ?X = "(bangRel weakBisim)"
  let ?Y = "Strong_Late_Bisim.bisim O (bangRel weakBisim) O Strong_Late_Bisim.bisim"

  from eqvt Strong_Late_Bisim.bisimEqvt have eqvtY: "eqvt ?Y" by(blast intro: eqvtBangRel)
  have XsubY: "?X  ?Y" by(auto intro: Strong_Late_Bisim.reflexive)

  have RelStay: "P Q. (P  !P, Q)  ?Y  (!P, Q)  ?Y"
  proof(auto)
    fix P Q R T
    assume PBisimQ: "P  !P  Q" 
       and QBRR: "(Q, R)  bangRel weakBisim"
       and RBisimT: "R  T"
    have "!P  Q" 
    proof -
      have "!P  P  !P" by(rule Strong_Late_Bisim_SC.bangSC)
      thus ?thesis using PBisimQ by(rule Strong_Late_Bisim.transitive)
    qed
    with QBRR RBisimT show "(!P, T)  ?Y" by blast
  qed
 
  have ParCompose: "P Q R T. P  Q; (R, T)  ?Y  (P  R, Q  T)  ?Y"
  proof -
    fix P Q R T
    assume PBisimQ: "P  Q"
       and RYT:     "(R, T)  ?Y"
    thus "(P  R, Q  T)  ?Y"
    proof(auto)
      fix T' R'
      assume T'BisimT: "T'  T" and RBisimR': "R  R'"
         and R'BRT': "(R', T')  bangRel weakBisim"
      have "P  R  P  R'"
      proof -
        from RBisimR' have "R  P  R'  P" by(rule Strong_Late_Bisim_Pres.parPres)
        moreover have "P  R  R  P" and "R'  P  P  R'" by(rule Strong_Late_Bisim_SC.parSym)+
        ultimately show ?thesis by(blast intro: Strong_Late_Bisim.transitive)
      qed
      moreover from PBisimQ R'BRT' have "(P  R', Q  T')  bangRel weakBisim" by(rule BRPar)
      moreover have "Q  T'  Q  T"
      proof -
        from T'BisimT have "T'  Q  T  Q" by(rule Strong_Late_Bisim_Pres.parPres)
        moreover have "Q  T'  T'  Q" and "T  Q  Q  T" by(rule Strong_Late_Bisim_SC.parSym)+
        ultimately show ?thesis by(blast intro: Strong_Late_Bisim.transitive)
      qed
      ultimately show ?thesis by blast
    qed
  qed

  have ResCong: "P Q x. (P, Q)  ?Y  (x>P, x>Q)  ?Y"
    by(auto intro: BRRes Strong_Late_Bisim_Pres.resPres transitive)

  from PBisimQ have "(!P, !Q)  ?X" by(rule BRBang)
  moreover from eqvt have "eqvt (bangRel weakBisim)" by(rule eqvtBangRel)
  ultimately show ?thesis
  proof(coinduct rule: weakBisimTransitiveCoinduct)
    case(cSim P Q)
    from (P, Q)  ?X
    show "P ^<?Y> Q"
    proof(induct)
      case(BRBang P Q)
      have "P  Q" by fact
      moreover hence "P ^<weakBisim> Q" by(blast dest: unfoldE)
      moreover have "P Q. P  Q  P ^<weakBisim> Q" by(blast dest: unfoldE)
      moreover from Strong_Late_Bisim.bisimEqvt eqvt have "eqvt ?Y" by(blast intro: eqvtBangRel)

      ultimately show "!P ^<?Y> !Q" using ParCompose ResCong RelStay XsubY
        by(rule_tac Weak_Late_Sim_Pres.bangPres, simp_all)
    next
      case(BRPar P Q R T)
      have PBiSimQ: "P  Q" by fact
      have RBangRelT: "(R, T)  ?X" by fact
      have RSimT: "R ^<?Y> T" by fact
      moreover from PBiSimQ  have "P ^<weakBisim> Q" by(blast dest: unfoldE)
      moreover from RBangRelT have "(R, T)  ?Y" by(blast intro: Strong_Late_Bisim.reflexive)
      ultimately show "P  R ^<?Y> Q  T" using ParCompose ResCong eqvt eqvtY P  Q
        by(rule_tac Weak_Late_Sim_Pres.parCompose)
    next
      case(BRRes P Q x)
      have "P ^<?Y> Q" by fact
      thus "x>P ^<?Y> x>Q" using ResCong eqvtY XsubY
        by(rule_tac Weak_Late_Sim_Pres.resPres, simp_all)
    qed
  next
    case(cSym P Q)
    thus ?case by(metis symmetric bangRelSymetric)
  qed
qed

end

Theory Weak_Late_Cong_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Cong_Pres
  imports Weak_Late_Cong Weak_Late_Step_Sim_Pres Weak_Late_Bisim_Pres
begin

lemma tauPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P  Q"

  shows "τ.(P)  τ.(Q)"
using assms
by(blast intro: unfoldI Weak_Late_Step_Sim_Pres.tauPres dest: congruenceWeakBisim symetric)

lemma outputPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P  Q"

  shows "a{b}.P  a{b}.Q"
using assms
by(blast intro: unfoldI Weak_Late_Step_Sim_Pres.outputPres dest: congruenceWeakBisim symetric)

lemma inputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   x :: name

  assumes PSimQ: "y. P[x::=y]  Q[x::=y]"
  
  shows "a<x>.P  a<x>.Q"
using assms
apply(rule_tac unfoldI)
apply(rule_tac Weak_Late_Step_Sim_Pres.inputPres, auto intro: congruenceWeakBisim)
by(rule_tac Weak_Late_Step_Sim_Pres.inputPres, auto intro: congruenceWeakBisim Weak_Late_Bisim.symmetric)

lemma matchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
using assms
by(blast intro: unfoldI Weak_Late_Step_Sim_Pres.matchPres dest: unfoldE symetric)

lemma mismatchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
using assms
by(blast intro: unfoldI Weak_Late_Step_Sim_Pres.mismatchPres dest: unfoldE symetric)

lemma sumPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P  Q"

  shows "P  R  Q  R"
using assms
by(blast intro: Weak_Late_Bisim.reflexive unfoldI Weak_Late_Step_Sim_Pres.sumPres dest: unfoldE symetric)

lemma parPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P  Q"

  shows "P  R  Q  R"
proof -
  have "P Q R. P ↝<weakBisim> Q; P  Q  P  R ↝<weakBisim> Q  R"
  proof -
    fix P Q R
    assume "P ↝<weakBisim> Q" and "P  Q"
    thus "P  R ↝<weakBisim> Q  R"
      using Weak_Late_Bisim_Pres.parPres Weak_Late_Bisim_Pres.resPres Weak_Late_Bisim.reflexive Weak_Late_Bisim.eqvt
      by(blast intro: Weak_Late_Step_Sim_Pres.parPres)
  qed
  with assms show ?thesis
    by(blast intro: unfoldI dest: congruenceWeakBisim unfoldE symetric)
qed

lemma resPres:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes PeqQ: "P  Q"
  
  shows "x>P  x>Q"
proof -
  have "P Q x. P ↝<weakBisim> Q  x>P ↝<weakBisim> x>Q"
  proof -
    fix P Q x
    assume "P ↝<weakBisim> Q"
    with Weak_Late_Bisim.eqvt Weak_Late_Bisim_Pres.resPres show "x>P ↝<weakBisim> x>Q"
      by(blast intro: Weak_Late_Step_Sim_Pres.resPres)
  qed
  with assms show ?thesis
    by(blast intro: unfoldI dest: congruenceWeakBisim unfoldE symetric)
qed

lemma congruenceBang:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P  Q"

  shows "!P  !Q"
proof -
  have "P Q. P ↝<weakBisim> Q; P  Q  !P ↝<weakBisim> !Q"
  proof -
    fix P Q
    assume "P ↝<weakBisim> Q" and "P  Q"
    hence "!P ↝<bangRel weakBisim> !Q" using unfoldE(1) congruenceWeakBisim Weak_Late_Bisim.eqvt 
      by(rule Weak_Late_Step_Sim_Pres.bangPres)
    moreover have "bangRel weakBisim  weakBisim"
      proof auto
        fix a b
        assume "(a, b)  bangRel weakBisim"
        thus   "a  b"
          apply(induct rule: bangRel.induct)
          apply (metis Weak_Late_Bisim_Pres.bangPres)
          apply (metis Weak_Late_Bisim.reflexive Weak_Late_Bisim.symmetric Weak_Late_Bisim.transitive Weak_Late_Bisim_Pres.parPres Weak_Late_Bisim_SC.parSym)
          by (metis Weak_Late_Bisim_Pres.resPres)
      qed
    ultimately show"!P ↝<weakBisim> !Q" 
      by(rule Weak_Late_Step_Sim.monotonic)
  qed

  with assms show ?thesis
    by(blast intro: unfoldI dest: unfoldE symetric congruenceWeakBisim)
qed

end

Theory Early_Semantics

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Early_Semantics
  imports Agent
begin

declare name_fresh[simp del]

nominal_datatype freeRes = InputR name name              ("_<_>" [110, 110] 110)
                         | OutputR name name             ("_[_]" [110, 110] 110)
                         | TauR                          ("τ" 110)

nominal_datatype residual = BoundOutputR name "«name» pi" ("__>  _" [110, 110, 110] 110)
                          | FreeR freeRes pi

lemma alphaBoundOutput:
  fixes a  :: name
  and   x  :: name
  and   P  :: pi
  and   x' :: name

  assumes A1: "x'  P"

  shows "ax>  P = ax'>  ([(x, x')]  P)"
proof(cases "x=x'")
  assume "x=x'"
  thus ?thesis by simp
next
  assume "x  x'"
  with A1 show ?thesis
    by(simp add: residual.inject alpha name_fresh_left name_calc)
qed

declare name_fresh[simp]

abbreviation Transitions_Freejudge ("_  _" [80, 80] 80) where "α  P'  (FreeR α P')"

inductive "TransitionsEarly" :: "pi  residual  bool" ("_  _" [80, 80] 80)
where
  Tau:               "τ.(P)  τ  P"
| Input:             "x  a; x  u  a<x>.P  a<u>  (P[x::=u])"
| Output:            "a{b}.P  a[b]   P"

| Match:             "P  V  [bb]P  V"
| Mismatch:          "P  V; a  b  [ab]P  V"

| Open:              "P  a[b]  P'; a  b  b>P  ab>  P'"
| Sum1:              "P  V  (P  Q)  V"
| Sum2:              "Q  V  (P  Q)  V"

| Par1B:             "P  ax>  P'; x  P; x  Q; x  a  P  Q  ax>  (P'  Q)"
| Par1F:             "P  α  P'  P  Q  α  (P'  Q)"
| Par2B:             "Q  ax>  Q'; x  P; x  Q; x  a  P  Q  ax>  (P  Q')"
| Par2F:             "Q  α  Q'  P  Q  α  (P  Q')"

| Comm1:             "P  a<b>  P'; Q  a[b]  Q'  P  Q  τ  P'  Q'"
| Comm2:             "P  a[b]  P'; Q  a<b>  Q'  P  Q  τ  P'  Q'"
| Close1:            "P  a<x>  P'; Q  ax>  Q'; x  P; x  Q; x  a  P  Q  τ  x>(P'  Q')"
| Close2:            "P  ax>  P'; Q  a<x>  Q'; x  P; x  Q; x  a  P  Q  τ  x>(P'  Q')"

| ResB:              "P  ax>  P'; y  a; y  x; x  P; x  a  y>P  ax>  (y>P')"
| ResF:              "P  α  P'; y  α  y>P  α  y>P'"

| Bang:              "P  !P  V  !P  V"

equivariance TransitionsEarly
nominal_inductive TransitionsEarly
by(auto simp add: abs_fresh fresh_fact2)

lemmas [simp] = freeRes.inject

lemma freshOutputAction:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   c  :: name

  assumes "P  a[b]  P'"
  and     "c  P"

  shows "c  a" and "c  b" and "c  P'"
proof -
  from assms have "c  a  c  b  c  P'"
    by(nominal_induct x2=="a[b]  P'" arbitrary: P' rule: TransitionsEarly.strong_induct) (fastforce simp add: residual.inject abs_fresh freeRes.inject)+
  thus "c  a" and "c  b" and "c  P'"
    by blast+
qed

lemma freshInputAction:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   c  :: name

  assumes "P  a<b>  P'"
  and     "c  P"

  shows "c  a"
using assms
by(nominal_induct x2=="a<b>  P'" arbitrary: P' rule: TransitionsEarly.strong_induct) (auto simp add: residual.inject abs_fresh)

lemma freshBoundOutputAction:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   c  :: name
  
  assumes "P  ax>  P'"
  and     "c  P"

  shows "c  a"
using assms
by(nominal_induct x2=="ax>  P'" avoiding: x arbitrary: P' rule: TransitionsEarly.strong_induct) (auto simp add: residual.inject abs_fresh fresh_left calc_atm dest: freshOutputAction)

lemmas freshAction = freshOutputAction freshInputAction freshBoundOutputAction

lemma freshInputTransition:
  fixes P  :: pi
  and   a  :: name
  and   u  :: name
  and   P' :: pi
  and   c  :: name

  assumes "P  a<u>  P'"
  and     "c  P"
  and     "c  u"

  shows "c  P'"
using assms
by(nominal_induct x2=="a<u>  P'" arbitrary: P' rule: TransitionsEarly.strong_induct)
  (fastforce simp add: residual.inject name_fresh_abs fresh_fact1 fresh_fact2)+
   
lemma freshBoundOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   c  :: name

  assumes "P  ax>  P'"
  and     "c  P"
  and     "c  x"

  shows "c  P'"
using assms
apply(nominal_induct x2=="ax>  P'" avoiding: x arbitrary: P' rule: TransitionsEarly.strong_induct)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction)
apply(auto simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction)
done

lemma freshTauTransition:
  fixes P  :: pi
  and   P' :: pi
  and   c  :: name

  assumes "P  τ  P'"
  and     "c  P"

  shows "c  P'"
using assms
apply(nominal_induct x2=="τ  P'" arbitrary: P' rule: TransitionsEarly.strong_induct)
by(fastforce simp add: residual.inject abs_fresh dest: freshOutputAction freshInputTransition freshBoundOutputTransition)+

lemma freshFreeTransition:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   c  :: name

  assumes "P α  P'"
  and     "c  P"
  and     "c  α"

  shows "c  P'"
using assms
by(nominal_induct α rule: freeRes.strong_inducts)
  (auto dest: freshInputTransition freshOutputAction freshTauTransition)

lemmas freshTransition = freshInputTransition freshOutputAction freshFreeTransition
                         freshBoundOutputTransition freshTauTransition

lemma substTrans[simp]: "b  P  ((P::pi)[a::=b])[b::=c] = P[a::=c]"
apply(simp add: injPermSubst[THEN sym])
apply(simp add: renaming)
by(simp add: pt_swap[OF pt_name_inst, OF at_name_inst])

lemma Input:
  fixes a :: name
  and   x :: name
  and   u :: name
  and   P :: pi

  shows "a<x>.P a<u>  P[x::=u]"
proof -
  obtain y::name where "y  a" and "y  u" and "y  P"
    by(generate_fresh "name") (auto simp add: fresh_prod)
  from y  a y  u have "a<y>.([(x, y)]  P) a<u>  ([(x, y)]  P)[y::=u]"
    by(rule Input)
  with y  P show ?thesis by(simp add: alphaInput renaming name_swap) 
qed

lemma Par1B:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi

  assumes "P ax>  P'"
  and     "x  Q"

  shows "P  Q  ax>  (P'  Q)"
proof -
  obtain y::name where "y  P" and "y  Q" and "y  a" and "y  P'"
    by(generate_fresh "name") (auto simp add: fresh_prod)
  from P ax>  P' y  P' have "P ay>  ([(x, y)]  P')"
    by(simp add: alphaBoundOutput)
  hence "P  Q ay>  (([(x, y)]  P')  Q)" using y  P y  Q y  a
    by(rule Par1B)
  with x  Q y  Q y  P' show ?thesis
    by(subst alphaBoundOutput) (auto simp add: name_fresh_fresh)
qed

lemma Par2B:
  fixes Q  :: pi
  and   a  :: name
  and   x  :: name
  and   Q' :: pi
  and   P  :: pi

  assumes "Q ax>  Q'"
  and     "x  P"

  shows "P  Q  ax>  (P  Q')"
proof -
  obtain y::name where "y  P" and "y  Q" and "y  a" and "y  Q'"
    by(generate_fresh "name") (auto simp add: fresh_prod)
  from Q ax>  Q' y  Q' have "Q ay>  ([(x, y)]  Q')"
    by(simp add: alphaBoundOutput)
  hence "P  Q ay>  (P  ([(x, y)]  Q'))" using y  P y  Q y  a
    by(rule Par2B)
  with x  P y  P y  Q' show ?thesis
    by(subst alphaBoundOutput[of y]) (auto simp add: name_fresh_fresh)
qed

lemma inputInduct[consumes 1, case_names cInput cMatch cMismatch cSum1 cSum2 cPar1 cPar2 cRes cBang]:
  fixes P  :: pi
  and   a  :: name
  and   u  :: name
  and   P' :: pi
  and   F  :: "'a::fs_name  pi  name  name  pi  bool"
  and   C  :: "'a::fs_name"

  assumes Trans:  "P a<u>  P'"
  and     "a x P u C. x  C; x  u; x  a  F C (a<x>.P) a u (P[x::=u])"
  and     "P a u P' b C. P a<u>  P'; C. F C P a u P'  F C ([bb]P) a u P'"
  and     "P a u P' b c C. P a<u>  P'; C. F C P a u P'; bc  F C ([bc]P) a u P'"
  and     "P a u P' Q C. P a<u>  P'; C. F C P a u P'  F C (P  Q) a u P'"
  and     "Q a u Q' P C. Q a<u>  Q'; C. F C Q a u Q'  F C (P  Q) a u Q'"
  and     "P a u P' Q C. P a<u>  P'; C. F C P a u P'  F C (P  Q) a u (P'  Q)"
  and     "Q a u Q' P C. Q a<u>  Q'; C. F C Q a u Q'  F C (P  Q) a u (P  Q')"
  and     "P a u P' x C. P a<u>  P'; x  a; x  u; x  C; C. F C P a u P'  F C (x>P) a u (x>P')"
  and     "P a u P' C. P  !P a<u>  P'; C. F C (P  !P) a u P'  F C (!P) a u P'"

  shows "F C P a u P'"
using assms
by(nominal_induct x2=="a<u>  P'" avoiding: C arbitrary: P' rule: TransitionsEarly.strong_induct)
  (auto simp add: residual.inject)

lemma inputAlpha:
  assumes "P a<u>  P'"
  and     "u  P"
  and     "r  P'"

  shows "P a<r>  ([(u, r)]  P')"
using assms
proof(nominal_induct avoiding: r rule: inputInduct)
  case(cInput a x P u r)
  from x  u u  a<x>.Phave "u  a" and "u  P" by(simp add: abs_fresh)+
  have "a<x>.P a<r>  P[x::=r]"
    by(rule Input)
  thus ?case using r  P[x::=u] u  P
    by(simp add: injPermSubst substTrans)
next
  case(cMatch P a u P' b r)
  thus ?case by(force intro: Match) 
next
  case(cMismatch P a u P' b c r)
  thus ?case by(force intro: Mismatch)
next
  case(cSum1 P a u P' Q r)
  thus ?case by(force intro: Sum1)
next
  case(cSum2 Q a u Q' P r)
  thus ?case by(force intro: Sum2)
next
  case(cPar1 P a u P' Q r)
  thus ?case by(force intro: Par1F simp add: eqvts name_fresh_fresh) 
next
  case(cPar2 Q a u Q' P r)
  thus ?case by(force intro: Par2F simp add: eqvts name_fresh_fresh) 
next
  case(cRes P a u P' x r)
  thus ?case by(force intro: ResF simp add: eqvts calc_atm abs_fresh) 
next
  case(cBang P a u P' R)
  thus ?case by(force intro: Bang)
qed

lemma Close1:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi

  assumes "P a<x>  P'"
  and     "Q ax>  Q'"
  and     "x  P"

  shows "P  Q τ  x>(P'  Q')"
proof -
  obtain y::name where "y  P" and "y  Q" and "y  a" and "y  Q'" and "y  P'"
    by(generate_fresh "name") (auto simp add: fresh_prod)
  from P a<x>  P' x  P y  P' have "P a<y>  ([(x, y)]  P')"
    by(rule inputAlpha)
  moreover from Q ax>  Q' y  Q' have "Q ay>  ([(x, y)]  Q')"
    by(simp add: alphaBoundOutput)
  
  ultimately have "P  Q τ  y>(([(x, y)]  P')  ([(x, y)]  Q'))" using y  P y  Q y  a
    by(rule Close1)
  with y  P' y  Q' show ?thesis by(subst alphaRes) (auto simp add: name_fresh_fresh)
qed

lemma Close2:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi

  assumes "P ax>  P'"
  and     "Q a<x>  Q'"
  and     "x  Q"

  shows "P  Q τ  x>(P'  Q')"
proof -
  obtain y::name where "y  P" and "y  Q" and "y  a" and "y  Q'" and "y  P'"
    by(generate_fresh "name") (auto simp add: fresh_prod)
  from P ax>  P' y  P' have "P ay>  ([(x, y)]  P')"
    by(simp add: alphaBoundOutput)
  moreover from Q a<x>  Q' x  Q y  Q' have "Q a<y>  ([(x, y)]  Q')"
    by(rule inputAlpha)
  
  ultimately have "P  Q τ  y>(([(x, y)]  P')  ([(x, y)]  Q'))" using y  P y  Q y  a
    by(rule Close2)
  with y  P' y  Q' show ?thesis by(subst alphaRes) (auto simp add: name_fresh_fresh)
qed

lemma ResB:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   y  :: name

  assumes "P ax>  P'"
  and     "y  a"
  and     "y  x"

  shows "y>P ax>  (y>P')"
proof -
  obtain z :: name where "z  P" and "z  P'" and "z  a" and "z  y"
    by(generate_fresh "name") (auto simp add: fresh_prod)
  from P ax>  P' z  P' have "P az>  ([(x, z)]  P')"
    by(simp add: alphaBoundOutput)
  hence "y>P az>  (y>([(x, z)]  P'))" using y  a z  y z  P z  a
    by(rule_tac ResB) auto
  thus ?thesis using z  y y  x z  P'
    by(subst alphaBoundOutput[where x'=z]) (auto simp add: eqvts calc_atm abs_fresh)
qed

lemma outputInduct[consumes 1, case_names Output Match Mismatch Sum1 Sum2 Par1 Par2 Res Bang]:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   F  :: "'a::fs_name  pi  name  name  pi  bool"
  and   C  :: "'a::fs_name"

  assumes Trans:  "P a[b]  P'"
  and     "a b P C. F C (a{b}.P) a b P"
  and     "P a b P' c C. P OutputR a b  P'; C. F C P a b P'  F C ([cc]P) a b P'"
  and     "P a b P' c d C. P OutputR a b  P'; C. F C P a b P'; cd  F C ([cd]P) a b P'"
  and     "P a b P' Q C. P OutputR a b  P'; C. F C P a b P'  F C (P  Q) a b P'"
  and     "Q a b Q' P C. Q OutputR a b  Q'; C. F C Q a b Q'  F C (P  Q) a b Q'"
  and     "P a b P' Q C. P OutputR a b  P'; C. F C P a b P'  F C (P  Q) a b (P'  Q)"
  and     "Q a b Q' P C. Q OutputR a b  Q'; C. F C Q a b Q'  F C (P  Q) a b (P  Q')"
  and     "P a b P' x C. P OutputR a b  P'; x  a; x  b; x  C; C. F C P a b P' 
                            F C (x>P) a b (x>P')"
  and     "P a b P' C. P  !P OutputR a b  P'; C. F C (P  !P) a b P'  F C (!P) a b P'"

  shows "F C P a b P'"
using assms
by(nominal_induct x2=="a[b]  P'" avoiding: C arbitrary: P' rule: TransitionsEarly.strong_induct)
  (auto simp add: residual.inject)

lemma boundOutputInduct[consumes 2, case_names Match Mismatch Open Sum1 Sum2 Par1 Par2 Res Bang]:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   F  :: "('a::fs_name)  pi  name  name  pi  bool"
  and   C  :: "'a::fs_name"

  assumes a: "P ax>  P'"
  and     xFreshP:  "x  P"
  and     cMatch:   "P a x P' b C. P ax>  P'; C. F C P a x P'  F C ([bb]P) a x P'"
  and     cMismatch:   "P a x P' b c C. P ax>  P'; C. F C P a x P'; b  c  F C ([bc]P) a x P'"
  and     cOpen:    "P a x P' C.   P (OutputR a x)  P'; a  x  F C (x>P) a x P'"
  and     cSum1:    "P Q a x P' C. P ax>  P'; C. F C P a x P'  F C (P  Q) a x P'" 
  and     cSum2:    "P Q a x Q' C. Q ax>  Q'; C. F C Q a x Q'  F C (P  Q) a x Q'" 
  and     cPar1B:   "P P' Q a x C. P ax>  P'; x  Q; C. F C P a x P' 
                                  F C (P  Q) a x (P'  Q)" 
  and     cPar2B:   "P Q Q' a x C. Q ax>  Q'; x  P; C. F C Q a x Q' 
                                  F C (P  Q) a x (P  Q')"
  and     cResB:    "P P' a x y C. P ax>  P'; y  a; y  x; y  C;
                                      C. F C P a x P'  F C (y>P) a x (y>P')"
  and     cBang:    "P a x P' C. P  !P ax>  P'; C. F C (P  !P) a x P' 
                                    F C (!P) a x P'"
  shows "F C P a x P'"
using assms
proof -
  have Goal: "P Rs a x P' C. P  Rs; Rs = ax>  P'; x  P  F C P a x P'"
  proof -
    fix P Rs a x P' C
    assume "P  Rs" and "Rs = ax>  P'" and "x  P"
    thus "F C P a x P'"
    proof(nominal_induct avoiding: C a x P' rule: TransitionsEarly.strong_induct)
      case(Tau P)
      thus ?case by(simp add: residual.inject)
    next
      case(Input P a x)
      thus ?case by(simp add: residual.inject)
    next
      case(Output P a b)
      thus ?case by(simp add: residual.inject)
    next
      case(Match P Rs b C a x P')
      thus ?case 
        by(force intro: cMatch simp add: residual.inject) 
    next
      case(Mismatch P Rs b c C a x P')
      thus ?case 
        by(force intro: cMismatch simp add: residual.inject) 
    next
      case(Sum1 P Q Rs C)
      thus ?case by(force intro: cSum1)
    next
      case(Sum2 P Q Rs C)
      thus ?case by(force intro: cSum2)
    next
      case(Open P a b P' C a' x P'')
      have "b  x" by fact hence bineqx: "b  x" by simp
      moreover have "ab>  P' = a'x>  P''" by fact
      ultimately have aeqa': "a=a'" and P'eqP'': "P'' = [(b, x)]  P'"
        by(simp add: residual.inject name_abs_eq)+
      have "x  b>P" by fact 
      with bineqx have xFreshP: "x  P" by(simp add: name_fresh_abs)
      have aineqb: "a  b" by fact

      have PTrans: "P a[b]  P'" by fact
      with xFreshP have xineqa: "x  a" by(force dest: freshAction)
      from PTrans have "([(b, x)]  P) [(b, x)]  (a[b]  P')" by(rule TransitionsEarly.eqvt)
      with P'eqP'' xineqa aineqb have Trans: "([(b, x)]  P) a[x]  P''"
        by(auto simp add: name_calc)
      hence "F C (x>([(b, x)]  P)) a x P''" using xineqa by(blast intro: cOpen)
      with xFreshP aeqa' show ?case by(simp add: alphaRes)
    next
      case(Par1B P  a x P' Q C a' x' P'')
      have "x  x'" by fact hence xineqx': "x  x'" by simp
      moreover have Eq: "ax>  (P'  Q) = a'x'>  P''" by fact
      hence aeqa': "a = a'" by(simp add: residual.inject)
      have xFreshQ: "x  Q" by fact
      have "x'  P  Q" by fact
      hence x'FreshP: "x'  P" and x'FreshQ: "x'  Q" by simp+
      have P''eq: "P'' = ([(x, x')]  P')  Q"
      proof -
        from Eq xineqx' have "(P'  Q) = [(x, x')]  P''"
          by(simp add: residual.inject name_abs_eq)
        hence "([(x, x')]  (P'  Q)) = P''" by simp
        with x'FreshQ xFreshQ show ?thesis by(simp add: name_fresh_fresh)
      qed

      have "x  P''" by fact
      with P''eq have x'FreshP': "x'  P'" by(simp add: name_fresh_left name_calc)

      have "P ax>  P'" by fact
      with x'FreshP' aeqa' have "P a'x'>  ([(x, x')]  P')"
        by(simp add: alphaBoundOutput)
      moreover have "C. F C P a x' ([(x, x')]  P')"
      proof -
        fix C
        have "C a' x' P''. ax>  P' = a'x'>  P''; x'  P  F C P a' x' P''" by fact
        moreover with aeqa' xineqx' x'FreshP' have "ax>  P' = a'x'>  ([(x, x')]  P')"
          by(simp add: residual.inject name_abs_eq name_fresh_left name_calc)
        ultimately show "F C P a x' ([(x, x')]  P')" using x'FreshP aeqa' by blast 
      qed
      ultimately have "F C (P  Q) a' x' (([(x, x')]  P')  Q)" using x'FreshQ aeqa'
        by(blast intro: cPar1B)
      with P''eq show ?case by simp
    next
      case(Par1F P P' Q α)
      thus ?case by(simp add: residual.inject)
    next
      case(Par2B Q a x Q' P C a' x' Q'')
      have "x  x'" by fact hence xineqx': "x  x'" by simp
      moreover have Eq: "ax>  (P  Q') = a'x'>  Q''" by fact
      hence aeqa': "a = a'" by(simp add: residual.inject)
      have xFreshP: "x  P" by fact
      have "x'  P  Q" by fact
      hence x'FreshP: "x'  P" and x'FreshQ: "x'  Q" by simp+
      have Q''eq: "Q'' = P  ([(x, x')]  Q')"
      proof -
        from Eq xineqx' have "(P  Q') = [(x, x')]  Q''"
          by(simp add: residual.inject name_abs_eq)
        hence "([(x, x')]  (P  Q')) = Q''" by simp
        with x'FreshP xFreshP show ?thesis by(simp add: name_fresh_fresh)
      qed

      have "x  Q''" by fact
      with Q''eq have x'FreshQ': "x'  Q'" by(simp add: name_fresh_left name_calc)

      have "Q ax>  Q'" by fact
      with x'FreshQ' aeqa' have "Q a'x'>  ([(x, x')]  Q')"
        by(simp add: alphaBoundOutput)
      moreover have "C. F C Q a x' ([(x, x')]  Q')"
      proof -
        fix C
        have "C a' x' Q''. ax>  Q' = a'x'>  Q''; x'  Q  F C Q a' x' Q''" by fact
        moreover with aeqa' xineqx' x'FreshQ' have "ax>  Q' = a'x'>  ([(x, x')]  Q')"
          by(simp add: residual.inject name_abs_eq name_fresh_left name_calc)
        ultimately show "F C Q a x' ([(x, x')]  Q')" using x'FreshQ aeqa' by blast 
      qed
      ultimately have "F C (P  Q) a' x' (P  ([(x, x')]  Q'))" using x'FreshP aeqa'
        by(blast intro: cPar2B)
      with Q''eq show ?case by simp
    next
      case(Par2F P P' Q α)
      thus ?case by(simp add: residual.inject)
    next
      case(Comm1 P P' Q Q' a b x)
      thus ?case by(simp add: residual.inject)
    next
      case(Comm2 P P' Q Q' a b x)
      thus ?case by(simp add: residual.inject)
    next
      case(Close1 P P' Q Q' a x y)
      thus ?case by(simp add: residual.inject)
    next
      case(Close2 P P' Q Q' a x y)
      thus ?case by(simp add: residual.inject)
    next
      case(ResB P a x P' y C a' x' P'')
      have "x  x'" by fact hence xineqx': "x  x'" by simp
      moreover have Eq: "ax>  (y>P') = a'x'>  P''" by fact
      hence aeqa': "a = a'" by(simp add: residual.inject)
      have "y  x'" by fact hence yineqx': "y  x'" by simp
      moreover have "x'  y>P" by fact
      ultimately have x'FreshP: "x'  P" by(simp add: name_fresh_abs)
      have yineqx: "y  x" and yineqa: "y  a" and yFreshC: "y  C" by fact+

      have P''eq: "P'' = y>([(x, x')]  P')"
      proof -
        from Eq xineqx' have "y>P' = [(x, x')]  P''"
          by(simp add: residual.inject name_abs_eq)
        hence "([(x, x')]  (y>P')) = P''" by simp
        with yineqx' yineqx show ?thesis by(simp add: name_fresh_fresh)
      qed

      have "x  P''" by fact
      with P''eq yineqx  have x'FreshP': "x'  P'" by(simp add: name_fresh_left name_calc name_fresh_abs)

      have "P ax>  P'" by fact
      with x'FreshP' aeqa' have "P a'x'>  ([(x, x')]  P')"
        by(simp add: alphaBoundOutput)
      moreover have "C. F C P a x' ([(x, x')]  P')"
      proof -
        fix C
        have "C a' x' P''. ax>  P' = a'x'>  P''; x'  P  F C P a' x' P''" by fact
        moreover with aeqa' xineqx' x'FreshP' have "ax>  P' = a'x'>  ([(x, x')]  P')"
          by(simp add: residual.inject name_abs_eq name_fresh_left name_calc)
        ultimately show "F C P a x' ([(x, x')]  P')" using x'FreshP aeqa' by blast 
      qed
      ultimately have "F C (y>P) a' x' (y>([(x, x')]  P'))" using yineqx' yineqa yFreshC aeqa'
        by(force intro: cResB)
      with P''eq show ?case by simp
    next
      case(ResF P P' α y)
      thus ?case by(simp add: residual.inject)
    next
      case(Bang P Rs)
      thus ?case by(force intro: cBang)
    qed
  qed
    
  with a xFreshP show ?thesis by simp
qed

lemma tauInduct[consumes 1, case_names Tau Match Mismatch Sum1 Sum2 Par1 Par2 Comm1 Comm2 Close1 Close2 Res Bang]:
  fixes P  :: pi
  and   P' :: pi
  and   F  :: "'a::fs_name  pi  pi  bool"
  and   C  :: "'a::fs_name"

  assumes Trans:  "P τ  P'"
  and     "P C. F C (τ.(P)) P"
  and     "P P' a C. P τ  P'; C. F C P P'  F C ([aa]P) P'"
  and     "P P' a b C. P τ  P'; C. F C P P'; a  b  F C ([ab]P) P'"
  and     "P P' Q C. P τ  P'; C. F C P P'  F C (P  Q) P'"
  and     "Q Q' P C. Q τ  Q'; C. F C Q Q'  F C (P  Q) Q'"
  and     "P P' Q C. P τ  P'; C. F C P P'  F C (P  Q) (P'  Q)"
  and     "Q Q' P C. Q τ  Q'; C. F C Q Q'  F C (P  Q) (P  Q')"
  and     "P a b P' Q Q' C. P a<b>  P'; Q OutputR a b  Q'  F C (P  Q) (P'  Q')"
  and     "P a b P' Q Q' C. P OutputR a b  P'; Q a<b>  Q'  F C (P  Q) (P'  Q')"
  and     "P a x P' Q Q' C. P a<x>  P'; Q ax>  Q'; x  P; x  Q; x  a; x  C  F C (P  Q) (x>(P'  Q'))"
  and     "P a x P' Q Q' C. P ax>  P'; Q a<x>  Q'; x  P; x  Q; x  a; x  C  F C (P  Q) (x>(P'  Q'))"
  and     "P P' x C. P τ  P'; x  C; C. F C P P' 
                        F C (x>P) (x>P')"
  and     "P P' C. P  !P τ  P'; C. F C (P  !P) P'  F C (!P) P'"

  shows "F C P P'"
using P τ  P'
by(nominal_induct x2=="τ  P'" avoiding: C arbitrary: P' rule: TransitionsEarly.strong_induct)
  (auto simp add: residual.inject intro: assms)+

inductive bangPred :: "pi  pi  bool"
where
  aux1: "bangPred P (!P)"
| aux2: "bangPred P (P  !P)"

inductive_cases tauCases'[simplified pi.distinct residual.distinct]: "τ.(P)  Rs"
inductive_cases inputCases'[simplified pi.inject residual.inject]: "a<b>.P  Rs"
inductive_cases outputCases'[simplified pi.inject residual.inject]: "a{b}.P  Rs"
inductive_cases matchCases'[simplified pi.inject residual.inject]: "[ab]P  Rs"
inductive_cases mismatchCases'[simplified pi.inject residual.inject]: "[ab]P  Rs"
inductive_cases sumCases'[simplified pi.inject residual.inject]: "P  Q  Rs"
inductive_cases parCasesB'[simplified pi.distinct residual.distinct]: "A  B  by>  A'"
inductive_cases parCasesF'[simplified pi.distinct residual.distinct]: "P  Q  α  P'"
inductive_cases resCasesB'[simplified pi.distinct residual.distinct]: "x'>A  ay'>  A'"
inductive_cases resCasesF'[simplified pi.distinct residual.distinct]: "x>A  α  A'"

lemma tauCases:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi

  assumes "τ.(P) α  P'"
  and     "Prop (τ) P"

  shows "Prop α P'"
using assms
by(cases rule: tauCases') (auto simp add: pi.inject residual.inject)

lemma inputCases[consumes 1, case_names cInput]:
  fixes a  :: name
  and   x  :: name
  and   P  :: pi
  and   P' :: pi

  assumes Input: "a<x>.P α  P'"
  and     A: "u. Prop (a<u>) (P[x::=u])"

  shows "Prop α P'"
proof -
  {
    fix x P
    assume "a<x>.P α  P'"
    moreover assume "(x::name)  α" and "x  P'" and "x  a"
    moreover assume "u. Prop (a<u>) (P[x::=u])"
    moreover obtain z::name where "z  x" and "z  P" and "z  α" and "z  P'"  and "z  a"
      by(generate_fresh "name", auto simp add: fresh_prod)
    moreover obtain z'::name where "z'  x" and "z'  z" and "z'  P" and "z'  α" and "z'  P'" and "z'  a"
      by(generate_fresh "name", auto simp add: fresh_prod)
    ultimately have "Prop α P'"
      by(cases rule: TransitionsEarly.strong_cases[where x=x and b=z and xa=z and xb=z and xc=z and xd=z and xe=z
                                                   and y=z' and ya=z'])
        (auto simp add: pi.inject residual.inject abs_fresh alpha)
   }
   note Goal = this
   obtain y::name where "y  P" and "y  α" and "y  P'" and "y  a"
     by(generate_fresh "name") (auto simp add: fresh_prod)
   from Input y  P have "a<y>.([(x, y)]  P) α  P'" by(simp add: alphaInput)
   moreover note y  α y  P' y  a
   moreover from A y  P have "u. Prop (a<u>) (([(x, y)]  P)[y::=u])"
     by(simp add: renaming name_swap)
   ultimately show ?thesis by(rule Goal)
qed

lemma outputCases:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi

  assumes "a{b}.P α  P'"
  and     "Prop (OutputR a b) P"

  shows "Prop α P'"
using assms
by(cases rule: outputCases') (auto simp add: pi.inject residual.inject)

lemma zeroTrans[dest]:
  fixes Rs :: residual

  assumes "𝟬  e Rs"

  shows "False"
using assms
by - (ind_cases "𝟬  e Rs")

lemma mismatchTrans[dest]:
  fixes a   :: name
  and   P   :: pi
  and   Rs  :: residual

  assumes "[aa]P  Rs"

  shows "False"
using assms
by(erule_tac mismatchCases') auto

lemma matchCases[consumes 1, case_names Match]:
  fixes a  :: name
  and   b  :: name
  and   P  :: pi
  and   Rs :: residual
  and   F  :: "name  name  bool"

  assumes Trans:  "[ab]P  Rs"
  and     cMatch: "P  Rs  F a a"

  shows "F a b"
using assms
by(erule_tac matchCases', auto)

lemma mismatchCases[consumes 1, case_names Mismatch]:
  fixes a  :: name
  and   b  :: name
  and   P  :: pi
  and   Rs :: residual
  and   F  :: "name  name  bool"

  assumes Trans:  "[ab]P  Rs"
  and     cMatch: "P  Rs; a  b  F a b"

  shows "F a b"
using assms  
by(erule_tac mismatchCases') auto

lemma sumCases[consumes 1, case_names Sum1 Sum2]:
  fixes P  :: pi
  and   Q  :: pi
  and   Rs :: residual

  assumes Trans: "P  Q  Rs"
  and     cSum1: "P  Rs  F"
  and     cSum2: "Q  Rs  F"

  shows F
using assms
by(erule_tac sumCases') auto

lemma parCasesB[consumes 1, case_names cPar1 cPar2]:
  fixes P   :: pi
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   PQ' :: pi
  
  assumes Trans: "P  Q  ax>  PQ'"
  and     icPar1B: "P'. P  ax>  P'; x  Q  F (P'  Q)"
  and     icPar2B: "Q'. Q  ax>  Q'; x  P  F (P  Q')"

  shows "F PQ'"
proof -
  from Trans show ?thesis
  proof(induct rule: parCasesB', auto simp add: pi.inject residual.inject)
    fix P' y
    assume PTrans: "P  ay>  P'"
    assume yFreshQ: "y  (Q::pi)"
    assume absEq: "[x].PQ' = [y].(P'  Q)"

    have "c::name. c  (P', x, y, Q)" by(blast intro: name_exists_fresh)
    then obtain c where cFreshP': "c  P'" and cineqx: "x  c" and cineqy: "c  y" and cFreshQ: "c  Q"
      by(force simp add: fresh_prod name_fresh)

    from cFreshP' PTrans have Trans: "P  ac>  ([(y, c)]  P')" by(simp add: alphaBoundOutput)

    from cFreshP' cFreshQ have "c  P'  Q" by simp
    hence "[y].(P'  Q) = [c].([(y, c)]  (P'  Q))"
      by(auto simp add: alpha fresh_left calc_atm)
    with yFreshQ cFreshQ have "[y].(P'  Q) = [c].(([(y, c)]  P')  Q)"
      by(simp add: name_fresh_fresh)

    with cineqx absEq have L1: "PQ' = [(x, c)]  (([(y, c)]  P')  Q)" and L2: "x  ([(y, c)]  P')  Q"
      by(simp add: name_abs_eq)+
    
    from L2 have xFreshQ: "x  Q" and xFreshP': "x  [(y, c)]  P'" by simp+
    with cFreshQ L1 have L3: "PQ' = ([(x, c)]  [(y, c)]  P')  Q" by(simp add: name_fresh_fresh)

    from Trans xFreshP' have "P  ax>  ([(x, c)]  [(y, c)]  P')" by(simp add: alphaBoundOutput name_swap)

    thus ?thesis using xFreshQ L3
      by(blast intro: icPar1B)
  next
    fix Q' y
    assume QTrans: "Q  ay>  Q'"
    assume yFreshP: "y  (P::pi)"
    assume absEq: "[x].PQ' = [y].(P  Q')"

    have "c::name. c  (Q', x, y, P)" by(blast intro: name_exists_fresh)
    then obtain c where cFreshQ': "c  Q'" and cineqx: "x  c" and cineqy: "c  y" and cFreshP: "c  P"
      by(force simp add: fresh_prod name_fresh)

    from cFreshQ' QTrans have Trans: "Q  ac>  ([(y, c)]  Q')" by(simp add: alphaBoundOutput)

    from cFreshQ' cFreshP have "c  P  Q'" by simp
    hence "[y].(P  Q') = [c].([(y, c)]  (P  Q'))"
      by(auto simp add: alpha fresh_left calc_atm)
    with yFreshP cFreshP have "[y].(P  Q') = [c].(P  ([(y, c)]  Q'))"
      by(simp add: name_fresh_fresh)

    with cineqx absEq have L1: "PQ' = [(x, c)]  (P  ([(y, c)]  Q'))" and L2: "x  P  ([(y, c)]  Q')"
      by(simp add: name_abs_eq)+
    
    from L2 have xFreshP: "x  P" and xFreshQ': "x  [(y, c)]  Q'" by simp+
    with cFreshP L1 have L3: "PQ' = P  ([(x, c)]  [(y, c)]  Q')" by(simp add: name_fresh_fresh)

    from Trans xFreshQ' have "Q  ax>  ([(x, c)]  [(y, c)]  Q')" by(simp add: alphaBoundOutput name_swap)

    thus ?thesis using xFreshP L3
      by(blast intro: icPar2B)
  qed
qed

lemma parCasesOutput[consumes 1, case_names Par1 Par2]:
  fixes P  :: pi
  and   Q  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes "P  Q a[b]  PQ'"
  and     "P'. P a[b]  P'  F (P'  Q)"
  and     "Q'. Q a[b]  Q'  F (P  Q')"

  shows "F PQ'"
using assms
by(erule_tac parCasesF', auto simp add: pi.inject residual.inject)

lemma parCasesInput[consumes 1, case_names Par1 Par2]:
  fixes P  :: pi
  and   Q  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes Trans: "P  Q a<b>  PQ'"
  and     icPar1F: "P'. P a<b>  P'  F (P'  Q)"
  and     icPar2F: "Q'. Q a<b>  Q'  F (P  Q')"

  shows "F PQ'"
using assms
by(erule_tac parCasesF') (auto simp add: pi.inject residual.inject)

lemma parCasesF[consumes 1, case_names cPar1 cPar2 cComm1 cComm2 cClose1 cClose2]:
  fixes P  :: pi
  and   Q  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   C  :: "'a::fs_name"

  assumes Trans: "P  Q  α  PQ'"
  and     icPar1F: "P'. P  α  P'  F α (P'  Q)"
  and     icPar2F: "Q'. Q  α  Q'  F α (P  Q')"
  and     icComm1: "P' Q' a b. P  a<b>  P'; Q  a[b]  Q'  F (τ) (P'  Q')"
  and     icComm2: "P' Q' a b. P  a[b]  P'; Q  a<b>  Q'  F (τ) (P'  Q')"
  and     icClose1: "P' Q' a x. P  a<x>  P'; Q  ax>  Q'; x  P; x  C  F (τ) (x>(P'  Q'))"
  and     icClose2: "P' Q' a x. P  ax>  P'; Q  a<x>  Q'; x  Q; x  C  F (τ) (x>(P'  Q'))"

  shows "F α PQ'"
proof -
  from Trans show ?thesis
  proof(rule parCasesF', auto)
    fix Pa Pa' Qa α'
    assume Trans': "Pa  α'  Pa'"
    assume Eq: "P  Q = Pa  Qa"
    assume Eq': "α  PQ' = α'  Pa'  Qa"

    from Eq have "P = Pa" and "Q = Qa"
      by(simp add: pi.inject)+
    
    moreover with Eq' have "α = α'" and "PQ' = Pa'  Q"
      by(simp add: residual.inject)+

    ultimately show ?thesis using icPar1F Trans'
      by simp
  next
    fix Pa Qa Qa' α'
    assume Trans': "Qa  α'  Qa'"
    assume Eq: "P  Q = Pa  Qa"
    assume Eq': "α  PQ' = α'  Pa  Qa'"

    from Eq have "P = Pa" and "Q = Qa"
      by(simp add: pi.inject)+
    
    moreover with Eq' have "α = α'" and "PQ' = P  Qa'"
      by(simp add: residual.inject)+

    ultimately show ?thesis using icPar2F Trans'
      by simp
  next
    fix Pa Pa' Qa Qa' a b
    assume TransP: "Pa  a<b>  Pa'"
    assume TransQ: "Qa  a[b]  Qa'"
    assume Eq: "P  Q = Pa  Qa"
    assume Eq': "α  PQ' = τ  Pa'  Qa'"

    from TransP TransQ Eq Eq' icComm1 show ?thesis
      by(simp add: pi.inject residual.inject)
  next
    fix Pa Pa' Qa Qa' a b x
    assume TransP: "Pa  (a::name)[b]  Pa'"
    assume TransQ: "Qa  a<b>  Qa'"
    assume Eq: "P  Q = Pa  Qa"
    assume Eq': "α  PQ' = τ  Pa'  Qa'"

    from TransP TransQ Eq Eq' icComm2 show ?thesis
      by(simp add: pi.inject residual.inject)
  next
    fix Pa Pa' Qa Qa' a x
    assume TransP: "Pa  a<x>  Pa'"
    assume TransQ: "Qa  ax>  Qa'"
    assume xFreshPa: "x  Pa"
    assume Eq: "P  Q = Pa  Qa"
    assume Eq': "α  PQ' = τ  x>(Pa'  Qa')"

    have "(c::name). c  (Pa, Pa', x, Qa', a, C)"
      by(blast intro: name_exists_fresh)
    then obtain c::name where cFreshPa: "c  Pa" and cFreshPa': "c  Pa'" and cineqy: "c  x" and cFreshQa': "c  Qa'" and cFreshC: "c  C" and cineqa: "c  a"
      by(force simp add: fresh_prod name_fresh)

    from cFreshQa' have L1: "ax>  Qa' = ac>  ([(x, c)]  Qa')"
      by(simp add: alphaBoundOutput)
    with cFreshQa' cFreshPa' have "c  (Pa'  Qa')"
      by simp
    then have L4: "x>(Pa'  Qa') = c>(([(x, c)]  Pa')  ([(x, c)]  Qa'))"
      by(simp add: alphaRes)

    have TransP: "Pa  a<c>  [(x, c)]  Pa'"
    proof -
      from xFreshPa TransP have xineqa: "xa" by(force dest: freshAction)
      from TransP have "([(x, c)]  Pa)  [(x, c)]  (a<x>  Pa')"
        by(rule TransitionsEarly.eqvt)
      with xineqa xFreshPa cFreshPa cineqa show ?thesis
        by(simp add: name_fresh_fresh name_calc)
    qed

    with TransQ L1 L4 icClose1 Eq Eq' cFreshPa cFreshC show ?thesis
      by(simp add: residual.inject, simp add: pi.inject)
  next
    fix Pa Pa' Qa Qa' a x
    assume TransP: "Pa  ax>  Pa'"
    assume TransQ: "Qa  a<x>  Qa'"
    assume xFreshQa: "x  Qa"
    assume Eq: "P  Q = Pa  Qa"
    assume Eq': "α  PQ' = τ  x>(Pa'  Qa')"

    have "(c::name). c  (Qa, Pa', x, Qa', a, C)"
      by(blast intro: name_exists_fresh)
    then obtain c::name where cFreshQa: "c  Qa" and cFreshPa': "c  Pa'" and cineqy: "c  x" and cFreshQa': "c  Qa'" and cFreshC: "c  C" and cineqa: "c  a"
      by(force simp add: fresh_prod name_fresh)

    from cFreshPa' have L1: "ax>  Pa' = ac>  ([(x, c)]  Pa')"
      by(simp add: alphaBoundOutput)
    with cFreshQa' cFreshPa' have "c  (Pa'  Qa')"
      by simp
    then have L4: "x>(Pa'  Qa') = c>(([(x, c)]  Pa')  ([(x, c)]  Qa'))"
      by(simp add: alphaRes)

    have TransQ: "Qa  a<c>  [(x, c)]  Qa'"
    proof -
      from xFreshQa TransQ have xineqa: "xa" by(force dest: freshAction)
      from TransQ have "([(x, c)]  Qa)  [(x, c)]  (a<x>  Qa')"
        by(rule TransitionsEarly.eqvt)
      with xineqa xFreshQa cFreshQa cineqa show ?thesis
        by(simp add: name_fresh_fresh name_calc)
    qed

    with TransP L1 L4 icClose2 Eq Eq' cFreshQa cFreshC show ?thesis
      by(simp add: residual.inject, simp add: pi.inject)
  qed
qed

lemma resCasesF[consumes 2, case_names Res]:
  fixes x :: name
  and   P  :: pi
  and   α  :: freeRes
  and   P' :: pi

  assumes Trans: "x>P  α  RP'"
  and     xFreshAlpha: "x  α"
  and     rcResF: " P'. P  α  P'  F (x>P')"

  shows "F RP'"
proof -
  from Trans show ?thesis
  proof(induct rule: resCasesF', auto)
    fix Pa Pa' β y
    assume PTrans: "Pa  β  Pa'"
    assume yFreshBeta: "(y::name)  β"
    assume TermEq: "x>P = y>Pa"
    assume ResEq: "α  RP' = β  y>Pa'"

    hence alphaeqbeta: "α = β" and L2: "RP' = y>Pa'" by(simp add: residual.inject)+

    have "(c::name). c  (Pa, α, Pa', x, y)" by(blast intro: name_exists_fresh)
    then obtain c::name where cFreshPa: "c  Pa" and cFreshAlpha: "c  α" and cFreshPa': "c  Pa'" and cineqx: "x  c" and cineqy: "c  y"
      by(force simp add: fresh_prod name_fresh)

    from cFreshPa have "y>Pa = c>([(y, c)]  Pa)" by(rule alphaRes)
    with TermEq cineqx have Peq: "P = [(x, c)]  [(y, c)]  Pa" and xeq: "x  [(y, c)]  Pa"
      by(simp add: pi.inject name_abs_eq)+

    from PTrans have "([(y, c)]  Pa)  [(y, c)]  (β  Pa')" by(rule TransitionsEarly.eqvt)
    with yFreshBeta cFreshAlpha alphaeqbeta have PTrans': "([(y, c)]  Pa)  α  ([(y, c)]  Pa')" 
      by(simp add: name_fresh_fresh)

    from PTrans' have "([(x, c)]  [(y, c)]  Pa)  [(x, c)]  (α  [(y, c)]  Pa')"
      by(rule TransitionsEarly.eqvt)
    with xFreshAlpha cFreshAlpha Peq have PTrans'': "P  α  [(x, c)]  [(y, c)]  Pa'"
      by(simp add: name_fresh_fresh)

    from PTrans' xeq xFreshAlpha have xeq': "x  [(y, c)]  Pa'"
      by(nominal_induct α rule: freeRes.strong_induct)
        (auto simp add: fresh_left calc_atm eqvts dest: freshTransition)

    from cFreshPa' have "y>Pa' = c>([(y, c)]  Pa')" by(rule alphaRes)
    moreover from xeq' have "c>([(y, c)]  Pa') = x>([(c, x)]  [(y, c)]  Pa')"
      by(rule alphaRes)
    ultimately have "RP' = x>([(x, c)]  [(y, c)]  Pa')" using ResEq
      by(simp add: residual.inject name_swap)

    with PTrans'' xFreshAlpha show ?thesis
      by(blast intro: rcResF)
  qed
qed

lemma resCasesB[consumes 2, case_names Open Res]:
  fixes x :: name
  and   P  :: pi
  and   a  :: name
  and   y :: name
  and   RP' :: pi

  assumes Trans:  "y>P  ax>  RP'"
  and     xineqy: "x  y"
  and     rcOpen: "P'. P (OutputR a y)  P'; a  y  F ([(x, y)]  P')"
  and     rcResB: "P'. P ax>  P'; y  a  F (y>P')"

  shows "F RP'"
proof -
  from Trans show ?thesis
  proof(induct rule: resCasesB', auto)
    fix Pa Pa' aa b
    assume PTrans: "Pa  (aa::name)[b]  Pa'"
    assume aaineqb: "aab"
    assume TermEq: "y>P = b>Pa"
    assume ResEq: "ax>  RP' = aab>  Pa'"

    have "(c::name). c  (x, a, aa, y, Pa, Pa', b)" by(blast intro: name_exists_fresh)
    then obtain c where cineqx: "cx" and cFresha: "c  a" and cineqy: "c  y" and cineqaa: "c  aa" and cFreshPa: "c  Pa" and cFreshPa': "c  Pa'" and cineqb: "c  b"
      by(force simp add: fresh_prod name_fresh)

    from cFreshPa have "b>Pa = c>([(b, c)]  Pa)" by(rule alphaRes)
    with cineqy TermEq have PEq: "P = [(y, c)]  [(b, c)]  Pa" and yFreshPa: "y  [(b, c)]  Pa"
      by(simp add: pi.inject name_abs_eq)+

    from PTrans have "([(b, c)]  Pa)  ([(b, c)]  (aa[b]  Pa'))" by(rule TransitionsEarly.eqvt)
    with aaineqb cineqaa have L1: "([(b, c)]  Pa)  aa[c]  [(b, c)]  Pa'" by(simp add: name_calc)
    with yFreshPa have yineqaa: "y  aa" by(force dest: freshAction)
    from L1 yFreshPa cineqy have yFreshPa': "y  [(b, c)]  Pa'" by(force intro: freshTransition)

    from L1 have "([(y, c)]  [(b, c)]  Pa)  [(y, c)]  (aa[c]  [(b, c)]  Pa')"
      by(rule TransitionsEarly.eqvt)
    with cineqaa yineqaa cineqy PEq have PTrans: "P  aa[y]  [(y, c)]  [(b, c)]  Pa'"
      by(simp add: name_calc)
    moreover from cFreshPa' have "aab>  Pa' = aac>  ([(b, c)]  Pa')" by(rule alphaBoundOutput)
    with ResEq cineqx have ResEq': "RP' = [(x, c)]  [(b, c)]  Pa'" and "x  [(b, c)]  Pa'"
      by(simp add: residual.inject name_abs_eq)+
    with xineqy cineqy cineqx yFreshPa' have "RP' = [(x, y)]  [(y, c)]  [(b, c)]  Pa'"
      by(subst pt_perm_compose[OF pt_name_inst, OF at_name_inst], simp add: name_calc name_fresh_fresh)
    moreover from ResEq have "a=aa" by(simp add: residual.inject)
    ultimately show ?thesis using yineqaa rcOpen
      by blast
  next
    fix Pa Pa' aa xa ya
    assume PTrans: "Pa  aaxa>  Pa'"
    assume yaFreshaa: "(ya::name)  aa"
    assume yaineqxa: "ya  xa"
    assume EqTrans: "y>P = ya>Pa"
    assume EqRes: "ax>  RP' = aaxa>  (ya>Pa')"
    
    hence aeqaa: "a = aa" by(simp add: residual.inject)
    with yaFreshaa have yaFresha: "ya  a" by simp

    have "(c::name). c  (Pa', y, xa, ya, x, Pa, aa)" by(blast intro: name_exists_fresh)
    then obtain c where cFreshPa': "c  Pa'" and cineqy: "c  y" and cineqxa: "c  xa" and cineqya: "c  ya" and cineqx: "c  x" and cFreshP: "c  Pa" and cFreshaa: "c  aa"
      by(force simp add: fresh_prod name_fresh)

    have "(d::name). d  (Pa, a, x, Pa', c, xa, ya, y)" by(blast intro: name_exists_fresh)
    then obtain d where dFreshPa: "d  Pa" and dFresha: "d  a" and dineqx: "d  x" and dFreshPa': "d  Pa'" and dineqc: "dc" and dineqxa: "d  xa" and dineqya: "d  ya" and dineqy: "d  y"
      by(force simp add: fresh_prod name_fresh)

    from dFreshPa have "ya>Pa = d>([(ya, d)]  Pa)" by(rule alphaRes)
    with EqTrans dineqy have PEq: "P = [(y, d)]  [(ya, d)]  Pa"
                         and yFreshPa: "y  [(ya, d)]  Pa"
      by(simp add: pi.inject name_abs_eq)+

    from dFreshPa' have L1: "ya>Pa' = d>([(ya, d)]  Pa')" by(rule alphaRes)
    from cFreshPa' dineqc cineqya have "c  d>([(ya, d)]  Pa')"
      by(simp add: name_fresh_abs name_calc name_fresh_left)
    hence "aaxa>  (d>([(ya, d)]  Pa')) = aac>  ([(xa, c)]  d>([(ya, d)]  Pa'))" (is "?LHS = _")
      by(rule alphaBoundOutput)
    with dineqxa dineqc have "?LHS = aac>  (d>([(xa, c)]  [(ya, d)]  Pa'))"
      by(simp add: name_calc)
    with L1 EqRes cineqx dineqc dineqx have
          RP'Eq: "RP' = d>([(x, c)]  [(xa, c)]  [(ya, d)]  Pa')"
      and xFreshPa': "x  [(xa, c)]  [(ya, d)]  Pa'"
      by(simp add: residual.inject name_abs_eq name_fresh_abs name_calc)+

    from PTrans aeqaa have "([(ya, d)]  Pa)  [(ya, d)]  (axa>  Pa')"
      by(blast intro: TransitionsEarly.eqvt)
    with yaineqxa yaFresha dineqxa dFresha have L1:
      "([(ya, d)]  Pa)  axa>  ([(ya, d)]  Pa')" by(simp add: name_calc name_fresh_fresh)
    with yFreshPa have yineqa: "y  a" by(force dest: freshAction)    
    from dineqc cineqya cFreshPa' have "c  [(ya, d)]  Pa'"
      by(simp add: name_fresh_left name_calc)
    hence "axa>  ([(ya, d)]  Pa') = ac>  ([(xa, c)]  [(ya, d)]  Pa')" (is "?LHS = _")
      by(rule alphaBoundOutput)
    with xFreshPa' have L2: "?LHS = ax>  ([(c, x)]  [(xa, c)]  [(ya, d)]  Pa')"
      by(simp add: alphaBoundOutput)
    with L1 PEq have "P  [(y, d)]  (ax>  ([(c, x)]  [(xa, c)]  [(ya, d)]  Pa'))"
      by(force intro: TransitionsEarly.eqvt simp del: residual.perm)
    with yineqa dFresha xineqy dineqx have Trans: "P  ax>  ([(y, d)]  [(c, x)]  [(xa, c)]  [(ya, d)]  Pa')"
      by(simp add: name_calc name_fresh_fresh)

    from L1 L2 yFreshPa xineqy have "y  [(c, x)]  [(xa, c)]  [(ya, d)]  Pa'"
      by(force intro: freshTransition)
    with RP'Eq have "RP' = y>([(y, d)]  [(c, x)]  [(xa, c)]  [(ya, d)]  Pa')"
      by(simp add: alphaRes name_swap)

    with Trans yineqa show ?thesis
      by(blast intro: rcResB)
  qed
qed

lemma bangInduct[consumes 1, case_names Par1B Par1F Par2B Par2F Comm1 Comm2 Close1 Close2 Bang]:
  fixes F  :: "'a::fs_name  pi  residual  bool"
  and   P  :: pi
  and   Rs :: residual
  and   C  :: "'a::fs_name"

  assumes Trans:  "!P  Rs"
  and     cPar1B: "a x P' C. P  ax>  P'; x  P; x  C  F  C (P  !P) (ax>  (P'  !P))"
  and     cPar1F: "(α::freeRes) (P'::pi) C. P  α  P'  F  C (P  !P) (α  P'  !P)"
  and     cPar2B: "a x P' C. !P  ax>  P'; x  P; x  C; C. F C (!P) (ax>  P')  F  C (P  !P) (ax>  (P  P'))"
  and     cPar2F: "α P' C. !P  α  P'; C. F C (!P) (α  P')  F C (P  !P) (α  P  P')"
  and     cComm1: "a P' b P'' C. P  a<b>  P'; !P  (OutputR a b)  P''; C. F C (!P) ((OutputR a b)  P'') 
                                     F C (P  !P) (τ  P'  P'')"
  and     cComm2: "a b P' P'' C. P  (OutputR a b)  P'; !P  a<b>  P''; C. F C (!P) (a<b>  P'') 
                                     F C (P  !P) (τ  P'  P'')"
  and     cClose1: "a x P' P'' C. P  a<x>  P'; !P  ax>  P''; x  P; x  C; C. F C (!P) (ax>  P'') 
                                     F C (P  !P) (τ  x>(P'  P''))"
  and     cClose2: "a x P' P'' C. P  ax>  P'; !P  a<x>  P''; x  P; x  C; C. F C (!P) (a<x>  P'') 
                                     F C (P  !P) (τ  x>(P'  P''))"
  and     cBang: "Rs C. P  !P  Rs; C. F C (P  !P) Rs  F C (!P) Rs"

  shows "F C (!P) Rs"
proof -
  have "X Y C. X  Y; bangPred P X  F C X Y"
  proof -
    fix X Y C
    assume "X  Y" and "bangPred P X"
    thus "F C X Y"
    proof(nominal_induct avoiding: C rule: TransitionsEarly.strong_induct)
      case(Tau Pa)
      thus ?case
        apply -
        by(ind_cases "bangPred P (τ.(Pa))")
    next
      case(Input x a u Pa C)
      thus ?case
        by - (ind_cases "bangPred P (a<x>.Pa)")
    next
      case(Output a b Pa C)
      thus ?case
        by - (ind_cases "bangPred P (a{b}.Pa)")
    next
      case(Match Pa Rs b C)
      thus ?case
        by - (ind_cases "bangPred P ([bb]Pa)")
    next
      case(Mismatch Pa Rs a b C)
      thus ?case
        by - (ind_cases "bangPred P ([a  b]Pa)")
    next
      case(Open Pa a b Pa')
      thus ?case
        by - (ind_cases "bangPred P (b>Pa)")
    next
      case(Sum1 Pa Rs Q)
      thus ?case
        by - (ind_cases "bangPred P (Pa  Q)")
    next
      case(Sum2 Q Rs Pa)
      thus ?case
        by - (ind_cases "bangPred P (Pa  Q)")
    next
      case(Par1B Pa a x P' Q C)
      thus ?case 
        by - (ind_cases "bangPred P (Pa  Q)", auto simp add: pi.inject cPar1B)
    next
      case(Par1F Pa α P' Q C)
      thus ?case
        by - (ind_cases "bangPred P (Pa  Q)", auto simp add: pi.inject cPar1F)
    next
      case(Par2B Q a x Q' Pa)
      thus ?case
        by - (ind_cases "bangPred P (Pa  Q)", auto simp add: pi.inject aux1 cPar2B)
    next
      case(Par2F Q α Q' Pa)
      thus ?case
        by - (ind_cases "bangPred P (Pa  Q)", auto simp add: pi.inject intro: cPar2F aux1)
    next
      case(Comm1 Pa a b Pa' Q Q' C)
      thus ?case
        by - (ind_cases "bangPred P (Pa  Q)", auto simp add: pi.inject intro: cComm1 aux1)
    next
      case(Comm2 Pa a b Pa' Q P'' C)
      thus ?case
        by - (ind_cases "bangPred P (Pa  Q)", auto simp add: pi.inject intro: cComm2 aux1)
    next
      case(Close1 Pa a x Pa' Q Q'' C)
      thus ?case
        by - (ind_cases "bangPred P (Pa  Q)", auto simp add: pi.inject aux1 cClose1)
    next
      case(Close2 Pa a x Pa' Q Q' C)
      thus ?case
        by - (ind_cases "bangPred P (Pa  Q)", auto simp add: pi.inject aux1 cClose2)
    next
      case(ResB Pa a x Pa' y)
      thus ?case
        by - (ind_cases "bangPred P (y>Pa)")
    next
      case(ResF Pa α Pa' y)
      thus ?case
        by - (ind_cases "bangPred P (y>Pa)")
    next
      case(Bang Pa Rs)
      thus ?case
        by - (ind_cases "bangPred P (!Pa)", auto simp add: pi.inject intro: aux2 cBang)
    qed
  qed
  with Trans show ?thesis by(force intro: bangPred.aux1)
qed

end

Theory Strong_Early_Sim

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Early_Sim
  imports Early_Semantics Rel
begin

definition "strongSimEarly" :: "pi  (pi × pi) set  pi  bool" ("_ ↝[_] _" [80, 80, 80] 80) where
  "P ↝[Rel] Q  (a y Q'. Q ay>  Q'  y  P  (P'. P ay>  P'  (P', Q')  Rel)) 
                 (α Q'. Q α  Q'  (P'. P α  P'  (P', Q')  Rel))"

lemma monotonic: 
  fixes A  :: "(pi × pi) set"
  and   B  :: "(pi × pi) set"
  and   P  :: pi
  and   P' :: pi

  assumes "P ↝[A] P'"
  and     "A  B"

  shows "P ↝[B] P'"
using assms
by(fastforce simp add: strongSimEarly_def)

lemma freshUnit[simp]:
  fixes y :: name

  shows "y  ()"
by(auto simp add: fresh_def supp_unit)

lemma simCasesCont[consumes 1, case_names Bound Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   C   :: "'a::fs_name"

  assumes Eqvt:  "eqvt Rel"
  and     Bound: "a y Q'. Q  ay>  Q'; y  P; y  Q; y  C  P'. P  ay>  P'  (P', Q')  Rel"
  and     Free:  "α Q'. Q  α  Q'  P'. P  α  P'  (P', Q')  Rel"

  shows "P ↝[Rel] Q"
proof -
  from Free show ?thesis
  proof(auto simp add: strongSimEarly_def)
    fix Q' a y
    assume yFreshP: "(y::name)  P"
    assume Trans: "Q  ay>  Q'"
    have "c::name. c  (P, Q', y, Q, C)" by(blast intro: name_exists_fresh)
    then obtain c::name where cFreshP: "c  P" and cFreshQ': "c  Q'" and cFreshC: "c  C"
                          and cineqy: "c  y" and "c  Q"
      by(force simp add: fresh_prod name_fresh)

    from Trans cFreshQ' have "Q  ac>  ([(y, c)]  Q')" by(simp add: alphaBoundOutput)
    hence "P'. P  ac>  P'  (P', [(y, c)]  Q')  Rel" using c  P c  Q c  C
      by(rule Bound)
    then obtain P' where PTrans: "P  ac>  P'" and P'RelQ': "(P', [(y, c)]  Q')  Rel"
      by blast

    from PTrans yFreshP cineqy have yFreshP': "y  P'" by(force intro: freshTransition)
    with PTrans have "P  ay>  ([(y, c)]  P')" by(simp add: alphaBoundOutput name_swap)
    moreover have "([(y, c)]  P', Q')  Rel" (is "?goal")
    proof -
      from Eqvt P'RelQ' have "([(y, c)]  P', [(y, c)]  [(y, c)]  Q')  Rel"
        by(rule eqvtRelI)
      with cineqy show ?goal by(simp add: name_calc)
    qed
    ultimately show "P'. P ay>  P'  (P', Q')  Rel" by blast
  qed
qed

lemma simCases[consumes 0, case_names Bound Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   C   :: "'a::fs_name"

  assumes Bound: "a y Q'. Q  ay>  Q'; y  P  P'. P  ay>  P'  (P', Q')  Rel"
  and     Free:  "α Q'. Q  α  Q'  P'. P  α  P'  (P', Q')  Rel"

  shows "P ↝[Rel] Q"
using assms
by(auto simp add: strongSimEarly_def)

lemma elim:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   Q'  :: pi

  assumes "P ↝[Rel] Q"

  shows "Q  ax>  Q'  x  P  P'. P  ax>  P'  (P', Q')  Rel"
  and   "Q  α  Q'  P'. P  α  P'  (P', Q')  Rel"
using assms by(simp add: strongSimEarly_def)+

lemma eqvtI:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   perm :: "name prm"

  assumes Sim: "P ↝[Rel] Q"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel': "eqvt Rel'"

  shows "(perm  P) ↝[Rel'] (perm  Q)"
proof(induct rule: simCases)
  case(Bound a y Q')
  have Trans: "(perm  Q)  ay>  Q'" by fact
  have yFreshP: "y  perm  P" by fact
  
  from Trans have "(rev perm  (perm  Q))  rev perm  (ay>  Q')"
    by(rule TransitionsEarly.eqvt)
  hence "Q  (rev perm  a)(rev perm  y)>  (rev perm  Q')" 
    by(simp add: name_rev_per)
  moreover from yFreshP have "(rev perm  y)  P" by(simp add: name_fresh_left)
  ultimately have "P'. P  (rev perm  a)(rev perm  y)>  P'  (P', rev perm  Q')  Rel" using Sim
    by(force intro: elim)
  then obtain P' where PTrans: "P  (rev perm  a)(rev perm  y)>  P'" and P'RelQ': "(P', rev perm  Q')  Rel"
    by blast
  
  from PTrans have "(perm  P)  perm  ((rev perm  a)(rev perm  y)>  P')" by(rule TransitionsEarly.eqvt)
  hence L1: "(perm  P)  ay>  (perm  P')" by(simp add: name_per_rev)
  from P'RelQ' RelRel' have "(P', rev perm  Q')  Rel'" by blast
  with EqvtRel' have "(perm  P', perm  (rev perm  Q'))  Rel'"
    by(rule eqvtRelI)
  hence "(perm  P', Q')  Rel'" by(simp add: name_per_rev)
  with L1 show ?case by blast
next
  case(Free α Q')
  have Trans: "(perm  Q)  α  Q'" by fact

  from Trans have "(rev perm  (perm  Q))  rev perm  (α  Q')"
    by(rule TransitionsEarly.eqvt)
  hence "Q  (rev perm  α)  (rev perm  Q')" 
    by(simp add: name_rev_per)
  with Sim have "P'. P  (rev perm  α)  P'  (P', (rev perm  Q'))  Rel"
    by(force intro: elim)
  then obtain P' where PTrans: "P  (rev perm  α)  P'" and PRel: "(P', (rev perm  Q'))  Rel" by blast
  
  from PTrans have "(perm  P)  perm  ((rev perm  α) P')" by(rule TransitionsEarly.eqvt)
  hence L1: "(perm  P)  α  (perm  P')" by(simp add: name_per_rev)
  from PRel EqvtRel' RelRel'  have "((perm  P'), (perm  (rev perm  Q')))  Rel'"
    by(force intro: eqvtRelI)
  hence "((perm  P'), Q')  Rel'" by(simp add: name_per_rev)
  with L1 show ?case by blast
qed


(*****************Reflexivity and transitivity*********************)

lemma reflexive:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "P ↝[Rel] P"
using assms
by(auto simp add: strongSimEarly_def)

lemmas fresh_prod[simp]

lemma transitive:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"
  and     QSimR: "Q ↝[Rel'] R"
  and     Eqvt': "eqvt Rel''"
  and     Trans: "Rel O Rel'  Rel''"

  shows "P ↝[Rel''] R"
proof -
  from Eqvt' show ?thesis
  proof(induct rule: simCasesCont[where C=Q])
    case(Bound a y R')
    have RTrans: "R  ay>  R'" by fact

    from QSimR RTrans y  Q have "Q'. Q  ay>  Q'  (Q', R')  Rel'"
      by(rule elim)
    then obtain Q' where QTrans: "Q  ay>  Q'" and Q'Rel'R': "(Q', R')  Rel'" by blast
    from PSimQ QTrans y  P have "P'. P  ay>  P'  (P', Q')  Rel"
      by(rule elim)
    then obtain P' where PTrans: "P  ay>  P'" and P'RelQ': "(P', Q')  Rel" by blast

    moreover from P'RelQ' Q'Rel'R' Trans have "(P', R')  Rel''" by blast

    ultimately show ?case by blast
  next
    case(Free α R')
    have RTrans: "R  α  R'" by fact
    with QSimR have "Q'. Q  α  Q'  (Q', R')  Rel'" by(rule elim)
    then obtain Q' where QTrans: "Q  α  Q'" and Q'RelR': "(Q', R')  Rel'" by blast
    from PSimQ QTrans have "P'. P  α  P'  (P', Q')  Rel" by(rule elim)
    then obtain P' where PTrans: "P  α  P'" and P'RelQ': "(P', Q')  Rel" by blast
    from P'RelQ' Q'RelR' Trans have "(P', R')  Rel''" by blast
    with PTrans show "P'. P  α  P'  (P', R')  Rel''" by blast
  qed
qed

end

Theory Strong_Early_Bisim

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Early_Bisim
  imports Strong_Early_Sim
begin

lemma monoAux: "A  B  P ↝[A] Q  P ↝[B] Q"
by(auto intro: Strong_Early_Sim.monotonic)

coinductive_set bisim :: "(pi × pi) set"
where
  step: "P ↝[bisim] Q; (Q, P)  bisim  (P, Q)  bisim"
monos monoAux

abbreviation strongBisimJudge (infixr "" 65) where "P  Q  (P, Q)  bisim"


lemma bisimCoinductAux[case_names bisim, case_conclusion StrongBisim step, consumes 1]:
  assumes p: "(P, Q)  X"
  and step:  "P Q. (P, Q)  X  P ↝[(X  bisim)] Q  (Q, P)  bisim  X"

  shows "P  Q"
proof -
  have aux: "X  bisim = {(P, Q). (P, Q)  X  P  Q}" by blast

  from p show ?thesis
    by(coinduct, force dest: step simp add: aux)
qed

lemma bisimCoinduct[consumes 1, case_names cSim cSym]:
  fixes P :: pi
  and   Q :: pi
  
  assumes "(P, Q)  X"
  and     "R S. (R, S)  X  R ↝[(X  bisim)] S"
  and     "R S. (R, S)  X  (S, R)  X"

  shows "P  Q"
using assms
by(coinduct rule: bisimCoinductAux) auto

lemma weak_coinduct[case_names bisim, case_conclusion StrongBisim step, consumes 1]:
  assumes p: "(P, Q)  X"
  and step:  "P Q. (P, Q)  X  P ↝[X] Q  (Q, P)  X"
 
  shows "P  Q"
using p
proof(coinduct rule: bisimCoinductAux)
  case (bisim P)
  from step[OF this] show ?case using Strong_Early_Sim.monotonic by blast
qed

lemma bisimWeakCoinduct[consumes 1, case_names cSim cSym]:
  fixes P :: pi
  and   Q :: pi
  
  assumes "(P, Q)  X"
  and     "P Q. (P, Q)  X  P ↝[X] Q"
  and     "P Q. (P, Q)  X  (Q, P)  X"

  shows "P  Q"
using assms
by(coinduct rule: weak_coinduct) auto

lemma monotonic: "mono(λp x1 x2.
        P Q. x1 = P 
              x2 = Q  P ↝[{(xa, x). p xa x}] Q  Q ↝[{(xa, x). p xa x}] P)"
apply(rule monoI)
by(auto intro: Strong_Early_Sim.monotonic)

lemma bisimE:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"
  
  shows "P ↝[bisim] Q"
  and   "Q  P"
using assms
by(auto intro: bisim.cases)

lemma bisimClosed[eqvt]:
  fixes P :: pi
  and   Q :: pi
  and   p :: "name prm"

  assumes "P  Q"

  shows "(p  P)  (p  Q)"
proof -
  let ?X = "{(p  P, p  Q) | (p::name prm) P Q. P  Q}"
  from assms have "(p  P, p  Q)  ?X" by auto
  thus ?thesis
  proof(coinduct rule: bisimWeakCoinduct)
    case(cSim P Q)
    moreover {
      fix P Q
      fix p::"name prm"
      assume "P ↝[bisim] Q"

      moreover have "bisim  ?X"
        by(auto, rule_tac x="[]" in exI) auto
      moreover have "eqvt ?X"
        by(auto simp add: eqvt_def pt2[OF pt_name_inst, THEN sym]) blast
      ultimately have "(p  P) ↝[?X] (p  Q)"
        by(rule Strong_Early_Sim.eqvtI)
    }
    ultimately show ?case by(blast dest: bisimE)
  next
    case(cSym P Q)
    thus ?case by(blast dest: bisimE)
  qed
qed

lemma eqvt[simp]:
  shows "eqvt bisim"
by(auto simp add: eqvt_def eqvts)

lemma reflexive:
  fixes P :: pi

  shows "P  P"
proof -
  have "(P, P)  Id" by simp
  then show ?thesis
    by(coinduct rule: bisimWeakCoinduct) (auto intro: Strong_Early_Sim.reflexive)
qed

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes PBiSimQ: "P  Q"
  and     QBiSimR: "Q  R"

  shows "P  R"
proof -
  let ?X = "bisim O bisim"
  from assms have "(P, R)  ?X" by blast
  thus ?thesis
  proof(coinduct rule: bisimWeakCoinduct)
    case(cSim P Q)
    moreover {
      fix P Q R
      assume "P  Q" and "Q  R"
      hence "P ↝[bisim] Q" and "Q ↝[bisim] R"
        by(metis bisimE)+
      moreover from eqvt have "eqvt ?X" by(auto simp add: eqvtTrans)
      moreover have "bisim O bisim  ?X" by auto

      ultimately have "P ↝[?X] R"
        by(rule Strong_Early_Sim.transitive)
    }
    ultimately show ?case by auto
  next
    case(cSym P Q)
    thus ?case by(auto dest: bisimE)
  qed
qed

end

Theory Strong_Early_Bisim_Subst

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Early_Bisim_Subst
  imports Strong_Early_Bisim
begin

abbreviation StrongCongEarlyJudge (infixr "s" 65) where   "P s Q  (P, Q)  (substClosed bisim)"

lemma congBisim:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"

  shows "P  Q"
using assms substClosedSubset by blast

lemma eqvt:
  shows "eqvt (substClosed bisim)"
by(rule eqvtSubstClosed[OF Strong_Early_Bisim.eqvt])

lemma eqvtI:
  fixes P :: pi
  and   Q :: pi
  and   perm :: "name prm"

  assumes "P s Q"

  shows "(perm  P) s (perm  Q)"
using assms
by(rule eqvtRelI[OF eqvt])

lemma reflexive:
  fixes P :: pi
  
  shows "P s P"
by(force simp add: substClosed_def intro: Strong_Early_Bisim.reflexive)

lemma symetric:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"
  
  shows "Q s P"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim.bisimE)

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  assumes "P s Q"
  and     "Q s R"
  
  shows "P s R"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim.transitive)

lemma partUnfold:
  fixes P :: pi
  and   Q :: pi
  and   s :: "(name × name) list"

  assumes "P s Q"

  shows "P[<s>] s Q[<s>]"
using assms
proof(auto simp add: substClosed_def)
  fix s'
  assume "s. P[<s>]  Q[<s>]"
  hence "P[<(s@s')>]  Q[<(s@s')>]" by blast
  moreover have "P[<(s@s')>] = (P[<s>])[<s'>]"
    by(induct s', auto)
  moreover have "Q[<(s@s')>] = (Q[<s>])[<s'>]"
    by(induct s', auto)
  
  ultimately show "(P[<s>])[<s'>]  (Q[<s>])[<s'>]"
    by simp
qed
  
end

Theory Strong_Early_Sim_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Early_Sim_Pres
  imports Strong_Early_Sim
begin

lemma tauPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "τ.(P) ↝[Rel] τ.(Q)"
proof(induct rule: simCases)
  case(Bound a y Q')
  have "τ.(Q)  ay>  Q'" by fact
  hence False by(induct rule: tauCases', auto)
  thus ?case by simp
next
  case(Free α Q')
  have "τ.(Q)  α  Q'" by fact
  thus "P'. τ.(P)  α   P'  (P', Q')  Rel"
  proof(induct rule: tauCases', auto simp add: pi.inject residual.inject)
    have "τ.(P)  τ  P" by(rule TransitionsEarly.Tau)
    with PRelQ show "P'. τ.(P)  τ  P'  (P', Q)  Rel" by blast
  qed
qed


lemma inputPres:
  fixes P    :: pi
  and   x    :: name
  and   Q    :: pi
  and   a    :: name
  and   Rel  :: "(pi × pi) set"

  assumes PRelQ: "y. (P[x::=y], Q[x::=y])  Rel"
  and     Eqvt: "eqvt Rel"

  shows "a<x>.P ↝[Rel] a<x>.Q"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, a, P, Q)"])
  case(Bound b y Q')
  from y  (x, a, P, Q) have "y  x" "y  a" "y  P" "y  Q" by simp+
  from a<x>.Q by>  Q' y  a y  x y  Q show ?case
    by(erule_tac inputCases') auto
next
  case(Free α Q')
  from a<x>.Q  α  Q'
  show ?case
  proof(induct rule: inputCases)
    case(cInput u)
    have "a<x>.P a<u>  P[x::=u]" by(rule Input)
    moreover from PRelQ have "(P[x::=u], Q[x::=u])  Rel" by auto
    ultimately show ?case by blast
  qed
qed

lemma outputPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "a{b}.P ↝[Rel] a{b}.Q"
proof(induct rule: simCases)
  case(Bound c y Q')
  have "a{b}.Q  cy>  Q'" by fact
  hence False by(induct rule: outputCases', auto)
  thus "P'. a{b}.P  cy>  P'  (P', Q')  Rel" by simp
next
  case(Free α Q')
  have "a{b}.Q  α  Q'" by fact
  thus "P'. a{b}.P  α  P'  (P', Q')  Rel"
  proof(induct rule: outputCases', auto simp add: pi.inject residual.inject)
    have "a{b}.P  a[b]  P" by(rule TransitionsEarly.Output)
    with PRelQ show "P'. a{b}.P  a[b]  P'  (P', Q)  Rel" by blast
  qed
qed

lemma matchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"
  and     RelRel': "Rel  Rel'"
  shows "[ab]P ↝[Rel'] [ab]Q"
proof(induct rule: simCases)
  case(Bound c y Q')
  have "(y::name)  [ab]P" by fact
  hence yFreshP: "y  P" by simp
  have "[ab]Q  cy>  Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case Match
    have "Q cy>  Q'" by fact
    with PSimQ yFreshP obtain P' where PTrans: "P cy>  P'" and P'RelQ': "(P', Q')  Rel" 
      by(blast dest: elim)
    
    from PTrans have "[aa]P  cy>  P'" by(rule Early_Semantics.Match)
    moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by blast
    ultimately show ?case by blast
  qed
next
  case(Free α Q')
  assume "[ab]Q  α  Q'"
  thus ?case
  proof(induct rule: matchCases)
    case Match
    have "Q  α  Q'" by fact
    with PSimQ obtain P' where PTrans: "P  α  P'" and P'RelQ': "(P', Q')  Rel" 
      by(blast dest: elim)

    from PTrans have "[aa]P α  P'" by(rule TransitionsEarly.Match)
    moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by blast
    ultimately show ?case by blast
  qed
qed

lemma mismatchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"
  and     RelRel': "Rel  Rel'"

  shows "[ab]P ↝[Rel'] [ab]Q"
proof(cases "a = b")
  assume "a = b"
  thus ?thesis
    by(auto simp add: strongSimEarly_def)
next
  assume aineqb: "a  b"
  show ?thesis
  proof(induct rule: simCases)
    case(Bound c x Q')
    have "x  [ab]P" by fact
    hence xFreshP: "x  P" by simp
    have "[ab]Q  cx>  Q'" by fact
    thus ?case
    proof(induct rule: mismatchCases)
      case Mismatch
      have "Q cx>  Q'" by fact
      with PSimQ xFreshP obtain P' where PTrans: "P cx>  P'"
                                     and P'RelQ': "(P', Q')  Rel"
        by(blast dest: elim)

      from PTrans aineqb have "[ab]P  cx>  P'" by(rule Early_Semantics.Mismatch)
      moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by blast
      ultimately show ?case by blast
    qed
  next
    case(Free α Q')
    have "[ab]Q α  Q'" by fact
    thus ?case
    proof(induct rule: mismatchCases)
      case Mismatch
      have "Q  α  Q'" by fact
      with PSimQ obtain P' where PTrans: "P  α  P'"
                             and PRel: "(P', Q')  Rel"
          by(blast dest: elim)
      from PTrans a  b have "[ab]P α  P'" by(rule TransitionsEarly.Mismatch)
      with RelRel' PRel show ?case by blast
    qed
  qed
qed

lemma sumPres:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"

  assumes "P ↝[Rel] Q"
  and     C1: "Id  Rel'"
  and     "Rel  Rel'"

  shows "P  R ↝[Rel'] Q  R"
proof(induct rule: simCases)
  case(Bound a y Q')
  have "y  P  R" by fact
  hence "(y::name)  P" and  "y  R" by simp+
  from Q  R ay>  Q' show ?case
  proof(induct rule: sumCases)
    case Sum1
    from P ↝[Rel] Q Q ay>  Q' y  P obtain P' where PTrans: "P ay>  P'" and P'RelQ': "(P', Q')  Rel" 
      by(blast dest: elim)
    
    from PTrans have "P  R ay>  P'" by(rule Early_Semantics.Sum1)
    moreover from P'RelQ' Rel  Rel' have "(P', Q')  Rel'" by blast
    ultimately show ?case by blast
  next
    case Sum2
    from R ay>  Q' have "P  R ay>  Q'" by(rule Early_Semantics.Sum2)
    moreover from C1 have "(Q', Q')  Rel'" by auto
    ultimately show ?case by blast
  qed
next
  case(Free α Q')
  from Q  R α  Q' show "P'. P  R  α  P'  (P', Q')  Rel'"
  proof(induct rule: sumCases)
    case Sum1
    have "Q α  Q'" by fact
    with P ↝[Rel] Q obtain P' where PTrans: "P α  P'" and P'RelQ': "(P', Q')  Rel" 
      by(blast dest: elim)

    from PTrans have "P  R α  P'" by(rule TransitionsEarly.Sum1)
    moreover from P'RelQ' Rel  Rel' have "(P', Q')  Rel'" by blast
    ultimately show ?case by blast
  next
    case Sum2
    from R α  Q' have "P  R α  Q'" by(rule TransitionsEarly.Sum2)
    moreover from C1 have "(Q', Q')  Rel'" by blast
    ultimately show ?case by blast
  qed
qed

lemma parCompose:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   T     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"
  
  assumes PSimQ:    "P ↝[Rel] Q"
  and     RSimT:    "R ↝[Rel'] S"
  and     PRelQ:    "(P, Q)  Rel"
  and     RRel'T:   "(R, S)  Rel'"
  and     Par:      "P' Q' R' S'. (P', Q')  Rel; (R', S')  Rel'  (P'  R', Q'  S')  Rel''"
  and     Res:      "S T x. (S, T)  Rel''  (x>S, x>T)  Rel''"

  shows "P  R ↝[Rel''] Q  S"
proof(induct rule: simCases)
  case(Bound a x Q')
  have "x  P  R" by fact
  hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
  have "Q  S  ax>  Q'" by fact
  thus ?case
  proof(induct rule: parCasesB)
    case(cPar1 Q')
    have "Q  ax>  Q'" by fact      
    with PSimQ xFreshP obtain P' where PTrans:"P  ax>  P'" and P'RelQ': "(P', Q')  Rel" 
      by(blast dest: elim)

    from PTrans xFreshR have "P  R  ax>  (P'  R)" by(rule Early_Semantics.Par1B)
    moreover from P'RelQ' RRel'T have "(P'  R, Q'  S)  Rel''" by(rule Par)
    ultimately show ?case by blast
  next
    case(cPar2 S')
    have "S  ax>  S'" by fact
    with RSimT xFreshR obtain R' where RTrans:"R  ax>  R'" and R'Rel'T': "(R', S')   Rel'" 
      by(blast dest: elim)

    from RTrans xFreshP have ParTrans: "P  R  ax>  (P  R')" by(rule Early_Semantics.Par2B)
    moreover from PRelQ R'Rel'T' have "(P  R', Q   S')  Rel''" by(rule Par)
    ultimately show ?case by blast
  qed
next
  case(Free α QT')
  have "Q  S  α  QT'" by fact
  thus ?case
  proof(induct rule: parCasesF[of _ _ _ _ _ "(P, R)"])
    case(cPar1 Q')
    have "Q  α  Q'" by fact
    with PSimQ obtain P' where PTrans: "P  α  P'" and PRel: "(P', Q')  Rel" 
      by(blast dest: elim)

    from PTrans have "P  R  α  P'  R" by(rule Early_Semantics.Par1F)
    moreover from PRel RRel'T have "(P'  R, Q'  S)  Rel''" by(rule Par)
    ultimately show ?case by blast
  next
    case(cPar2 S')
    have "S  α  S'" by fact
    with RSimT obtain R' where RTrans: "R  α  R'" and RRel: "(R', S')  Rel'" 
      by(blast dest: elim)

    from RTrans have "P  R  α  P  R'" by(rule Early_Semantics.Par2F)
    moreover from PRelQ RRel have "(P  R', Q  S')  Rel''" by(rule Par)
    ultimately show ?case by blast
  next
    case(cComm1 Q' S' a b)
    have "Q  a<b>  Q'" by fact
    with PSimQ obtain P' where PTrans: "P a<b>  P'" and P'RelQ': "(P', Q')  Rel"
      by(blast dest: elim)
    
    have "S  a[b]  S'" by fact
    with RSimT obtain R' where RTrans: "R a[b]  R'" and RRel: "(R', S')  Rel'"
      by(blast dest: elim)
    
    from PTrans RTrans have "P  R  τ  P'  R'" by(rule Early_Semantics.Comm1)
    moreover from P'RelQ' RRel have "(P'  R', Q'  S')  Rel''" by(rule Par)
    ultimately show ?case by blast
  next
    case(cComm2 Q' S' a b)
    have "Q  (OutputR a b)  Q'" by fact
    with PSimQ obtain P' where PTrans: "P a[b]  P'" and PRel: "(P', Q')  Rel" 
      by(blast dest: elim)
    
    have "S  a<b>  S'" by fact
    with RSimT obtain R' where RTrans: "R a<b>  R'" and R'Rel'T': "(R', S')  Rel'"
      by(blast dest: elim)
    
    from PTrans RTrans have "P  R  τ  P'  R'" by(rule Early_Semantics.Comm2)
    moreover from PRel R'Rel'T' have "(P'  R', Q'  S')  Rel''" by(rule Par)
    ultimately show ?case by blast
  next
    case(cClose1 Q' S' a x)
    have "x  (P, R)" by fact
    hence xFreshP: "x  P" and xFreshR: "x  R" by simp+

    have "Q  a<x>  Q'" by fact
    with PSimQ obtain P' where PTrans: "P a<x>  P'" and P'RelQ': "(P', Q')  Rel"
      by(blast dest: elim)
    
    have "S  ax>  S'" by fact
    with RSimT xFreshR obtain R' where RTrans: "R ax>  R'" and R'Rel'T': "(R', S')  Rel'"
      by(blast dest: elim)
    
    from PTrans RTrans xFreshP have "P  R  τ  x>(P'  R')"
      by(rule Early_Semantics.Close1)
    moreover from P'RelQ' R'Rel'T' have "(x>(P'  R'), x>(Q'  S'))  Rel''"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  next
    case(cClose2 Q' S' a x)
    have "x  (P, R)" by fact
    hence xFreshP: "x  P" and xFreshR: "x  R" by simp+

    have "Q  ax>  Q'" by fact
    with PSimQ xFreshP obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel" 
      by(blast dest: elim)
    
    have "S  a<x>  S'" by fact
    with RSimT obtain R' where RTrans: "R a<x>  R'" and R'Rel'T': "(R', S')  Rel'" 
      by(blast dest: elim)
    
    from PTrans RTrans xFreshR have "P  R  τ  x>(P'  R')"
      by(rule Early_Semantics.Close2)
    moreover from P'RelQ' R'Rel'T' have "(x>(P'  R'), x>(Q'  S'))  Rel''"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  qed
qed

lemma parPres:
  fixes P   :: pi
  and   Q   :: pi
  and   R   :: pi
  and   a   :: name
  and   b   :: name
  and   Rel :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"
  
  assumes PSimQ:    "P ↝[Rel] Q"
  and     PRelQ:    "(P, Q)  Rel"
  and     Par:      "S T U. (S, T)  Rel  (S  U, T  U)  Rel'"
  and     Res:      "S T x. (S, T)  Rel'  (x>S, x>T)  Rel'"

  shows "P  R ↝[Rel'] Q  R"
proof -
  note PSimQ 
  moreover have RSimR: "R ↝[Id] R" by(auto intro: reflexive)
  moreover note PRelQ moreover have "(R, R)  Id" by auto
  moreover from Par have "P Q R T. (P, Q)  Rel; (R, T)  Id  (P  R, Q  T)  Rel'"
    by auto
  ultimately show ?thesis using Res by(rule parCompose)
qed

lemma resPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   x    :: name
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"
  and     ResSet: "(R::pi) (S::pi) (y::name). (R, S)  Rel  (y>R, y>S)  Rel'"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel: "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "x>P ↝[Rel'] x>Q"
proof -
  from EqvtRel' show ?thesis
  proof(induct rule: simCasesCont[where C = "(P, x)"])
    case(Bound a y Q')
    have Trans: "x>Q ay>  Q'" by fact
    have "y  (P, x)" by fact
    hence yineqx: "y  x" and yFreshP: "y  (P::pi)" by simp+
    from Trans yineqx show ?case
    proof(induct rule: resCasesB)
      case(Open Q')
      have QTrans: "Q (a::name)[x]  Q'" by fact
      with PSimQ obtain P' where PTrans: "P  a[x]  P'" and P'RelQ': "(P', Q')  Rel" 
        by(blast dest: elim)

      have "x>P ay>  ([(y, x)]  P')"
      proof -
        have aineqx: "a  x" by fact
        with PTrans have "x>P ax>  P'" by(rule TransitionsEarly.Open)
        moreover have "ax>  P' = ay>  ([(y, x)]  P')" 
        proof -
          from PTrans yFreshP have yFreshP': "y  P'" by(force intro: freshTransition)
          thus ?thesis by(simp add: alphaBoundOutput name_swap)
        qed
        ultimately show ?thesis by simp
      qed
      moreover from EqvtRel P'RelQ' RelRel' have "([(y, x)]  P', [(y, x)]  Q')  Rel'" 
        by(blast intro: eqvtRelI)
      ultimately show ?case by blast
    next
      case(Res Q')
      have QTrans: "Q ay>  Q'" by fact

      with PSimQ yFreshP obtain P' where PTrans: "P ay>  P'" and P'RelQ': "(P', Q')  Rel"
        by(blast dest: elim)

      have xineqa: "x  a" by fact
      with PTrans yineqx have ResTrans: "x>P ay>  (x>P')"
        by(blast intro: ResB)
      moreover from P'RelQ' have "((x>P'), (x>Q'))  Rel'"
        by(rule ResSet)

      ultimately show "P'. x>P  ay>  P'  (P', (x>Q'))  Rel'" by blast
    qed
  next
    case(Free α Q')
    have Trans: "x>Q  α  Q'" by fact
    have "c::name. c  (P, Q, Q', α)" by(blast intro: name_exists_fresh)
    then obtain c::name where cFreshQ: "c  Q" and cFreshAlpha: "c  α" and cFreshQ': "c  Q'" and cFreshP: "c  P"
      by(force simp add: fresh_prod)
    from cFreshP have "x>P = c>([(x, c)]  P)" by(simp add: alphaRes)
    moreover have "P'.c>([(x, c)]  P)  α  P'  (P', Q')  Rel'"
    proof -
      from Trans cFreshQ have "c>([(x, c)]  Q) α  Q'" by(simp add: alphaRes)
      moreover from EqvtRel PSimQ have "([(x, c)]  P) ↝[Rel] ([(x, c)]  Q)"
        by(blast intro: eqvtI)
      ultimately show ?thesis using cFreshAlpha
        apply -
        apply(erule resCasesF)
        apply auto
        by(blast intro: ResF ResSet dest: elim)
    qed

    ultimately show "P'.x>P  α  P'  (P', Q')  Rel'" by auto
  qed
qed

lemma resChainI:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   lst :: "name list"

  assumes eqvtRel: "eqvt Rel"
  and     Res:     "R S x. (R, S)  Rel  (x>R, x>S)  Rel"
  and     PRelQ:   "P ↝[Rel] Q"

  shows "(resChain lst) P ↝[Rel] (resChain lst) Q"
proof -
  show ?thesis
  proof(induct lst) (* Base case *)
    from PRelQ show "resChain [] P ↝[Rel] resChain [] Q" by simp
  next (* Inductive step *)
    fix a lst
    assume IH: "(resChain lst P) ↝[Rel] (resChain lst Q)"
    moreover from Res have "P Q a. (P, Q)  Rel  (a>P, a>Q)  Rel"
      by simp
    moreover have "Rel  Rel" by simp
    ultimately have "a>(resChain lst P) ↝[Rel] a>(resChain lst Q)" using eqvtRel
      by(rule_tac resPres)
    thus "resChain (a # lst) P ↝[Rel] resChain (a # lst) Q"
      by simp
  qed
qed

lemma bangPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
 
  assumes PRelQ:    "(P, Q)  Rel"
  and     Sim:      "R S. (R, S)  Rel  R ↝[Rel] S"
  and     eqvtRel:  "eqvt Rel"

  shows "!P ↝[bangRel Rel] !Q"
proof -
  let ?Sim = "λP Rs. (a x Q'. Rs = ax>  Q'  x  P  (P'. P ax>  P'  (P', Q')  bangRel Rel)) 
                     (α Q'. Rs = α  Q'  (P'. P α  P'  (P', Q')  bangRel Rel))"
  from eqvtRel have EqvtBangRel: "eqvt(bangRel Rel)" by(rule eqvtBangRel)

  {
    fix Pa Rs
    assume "!Q  Rs" and "(Pa, !Q)  bangRel Rel"
    hence "?Sim Pa Rs" using PRelQ
    proof(nominal_induct avoiding: Pa P rule: bangInduct)
      case(Par1B a x Q' Pa P)
      have QTrans: "Q  ax>  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" and "x  Pa" by fact+
      thus "?Sim Pa (ax>  (Q'  !Q))"
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" by fact
        have PBRQ: "(R, !Q)  bangRel Rel" by fact
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        show ?case 
        proof(auto simp add: residual.inject alpha')
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)

          with QTrans xFreshP obtain P' where PTrans: "P  ax>  P'" and P'RelQ': "(P', Q')  Rel"
            by(blast dest: elim)

          from PTrans xFreshR have "P  R  ax>  (P'  R)"
            by(force intro: Early_Semantics.Par1B)
          moreover from P'RelQ' PBRQ have "(P'  R, Q'  !Q)  bangRel Rel" by(rule Rel.BRPar)
          ultimately show "P'. P  R ax>  P'  (P', Q'  !Q)  bangRel Rel" by blast
        next
          fix y
          assume "(y::name)  Q'" and "y  P" and "y  R" and "y  Q"
          from QTrans y  Q' have "Q ay>  ([(x, y)]  Q')"
            by(simp add: alphaBoundOutput)
          moreover from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          ultimately obtain P' where PTrans: "P ay>  P'" and P'RelQ': "(P', [(x, y)]  Q')  Rel"
            using y  P
            by(blast dest: elim)
          from PTrans y  R have "P  R ay>  (P'  R)" by(force intro: Early_Semantics.Par1B)
          moreover from P'RelQ' PBRQ have "(P'  R, ([(x, y)]  Q')  !Q)  bangRel Rel" by(rule Rel.BRPar)
          with x  Q y  Q have "(P'  R, ([(y, x)]  Q')  !([(y, x)]  Q))  bangRel Rel"
            by(simp add: name_fresh_fresh name_swap)
          ultimately show "P'. P  R ay>  P'  (P', ([(y, x)]  Q')  !([(y, x)]  Q))  bangRel Rel"
            by blast
        qed
      qed
    next
      case(Par1F α Q' Pa P)
      have QTrans: "Q α  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and BR: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P  α  P'" and RRel: "(P', Q')  Rel"
            by(blast dest: elim)
          
          from PTrans have "P  R  α  P'  R" by(rule TransitionsEarly.Par1F)
          moreover from RRel BR have "(P'  R, Q'  !Q)  bangRel Rel" by(rule Rel.BRPar)
          ultimately show "P'. P  R  α  P'  (P', Q'  !Q)  bangRel Rel" by blast
        qed
      qed
    next
      case(Par2B a x Q' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (ax>  Q')" by simp
      have "(Pa, Q  !Q)  bangRel Rel" and "x  Pa" by fact+
      thus "?Sim Pa (ax>  (Q  Q'))"
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+

        from EqvtBangRel show "?Sim (P  R) (ax>  (Q  Q'))"
        proof(auto simp add: residual.inject alpha')
          from RBRQ have "?Sim R (ax>  Q')" by(rule IH)
          with xFreshR obtain R' where RTrans: "R  ax>  R'" and R'BRQ': "(R', Q')  (bangRel Rel)"
            by(metis elim)
          from RTrans xFreshP have "P  R  ax>  (P  R')" by(auto intro: Early_Semantics.Par2B)
          moreover from PRelQ R'BRQ' have "(P  R', Q  Q')  (bangRel Rel)" by(rule Rel.BRPar)
          ultimately show "P'. P  R  ax>  P'  (P', Q  Q')  bangRel Rel" by blast
        next
          fix y
          assume "(y::name)  Q" and "y  Q'" and "y  P" and "y  R"
          from RBRQ have "?Sim R (ax>  Q')" by(rule IH)
          with y  Q' have "?Sim R (ay>  ([(x, y)]  Q'))" by(simp add: alphaBoundOutput)
          with y  R obtain R' where RTrans: "R  ay>  R'" and R'BRQ': "(R', ([(x, y)]  Q'))  (bangRel Rel)"
            by(metis elim)
          from RTrans y  P have "P  R  ay>  (P  R')" by(auto intro: Early_Semantics.Par2B)
          moreover from PRelQ R'BRQ' have "(P  R', Q  ([(x, y)]  Q'))  (bangRel Rel)" by(rule Rel.BRPar)
          with y  Q x  Q have "(P  R', ([(y, x)]  Q)  ([(y, x)]  Q'))  (bangRel Rel)"
            by(simp add: name_swap name_fresh_fresh)
          ultimately show "P'. P  R  ay>  P'  (P', ([(y, x)]  Q)  ([(y, x)]  Q'))  bangRel Rel" by blast
        qed
      qed
    next
      case(Par2F α Q' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (α  Q')" by simp
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from RBRQ IH have "R'. R  α  R'  (R', Q')  bangRel Rel"
            by(metis elim)
          then obtain R' where RTrans: "R  α  R'" and R'RelQ': "(R', Q')  bangRel Rel"
            by blast

          from RTrans have "P  R  α  P  R'" by(rule TransitionsEarly.Par2F)
          moreover from PRelQ R'RelQ' have "(P  R', Q  Q')  bangRel Rel" by(rule Rel.BRPar)
          ultimately show " P'. P  R  α  P'  (P', Q  Q')  bangRel Rel" by blast
        qed
      qed
    next
      case(Comm1 a Q' b Q'' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (a[b]  Q'')" by simp
      have QTrans: "Q a<b>  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P  a<b>  P'" and P'RelQ': "(P', Q')  Rel"
            by(blast dest: elim)
          
          from IH RBRQ have RTrans: "R'. R  a[b]  R'  (R', Q'')  bangRel Rel"
            by(metis elim)
          then obtain R' where RTrans: "R  a[b]  R'" and R'RelQ'': "(R', Q'')  bangRel Rel"
            by blast
          
          from PTrans RTrans have "P  R τ  P'  R'" by(rule TransitionsEarly.Comm1)
          moreover from P'RelQ' R'RelQ'' have "(P'  R', Q'  Q'')  bangRel Rel" by(rule Rel.BRPar)
          ultimately show "P'. P  R  τ  P'  (P', Q'  Q'')  bangRel Rel" by blast
        qed
      qed
    next
      case(Comm2 a b Q' Q'')
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (a<b>  Q'')" by simp
      have QTrans: "Q  a[b]  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P  a[b]  P'" and P'RelQ': "(P', Q')  Rel"
            by(blast dest: elim)

          from IH RBRQ have RTrans: "R'. R  a<b>  R'  (R', Q'')  bangRel Rel"
            by(metis elim)
          then obtain R' where RTrans: "R  a<b>  R'" and R'RelQ'': "(R', Q'')  bangRel Rel"
            by blast

          from PTrans RTrans have "P  R  τ  P'  R'" by(rule TransitionsEarly.Comm2)
          moreover from P'RelQ' R'RelQ'' have "(P'  R', Q'  Q'')  bangRel Rel" by(rule Rel.BRPar)
          ultimately show "P'. P  R  τ  P'  (P', Q'  Q'')  bangRel Rel" by blast
        qed
      qed
    next
      case(Close1 a x Q' Q'' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (ax>  Q'')" by simp
      have QTrans: "Q  a<x>  Q'" by fact
      have xFreshQ: "x  Q" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      moreover have xFreshPa: "x  Pa" by fact
      ultimately show ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          with QTrans xFreshP obtain P' where PTrans: "P a<x>  P'" and P'RelQ': "(P', Q')  Rel"
             by(blast dest: elim)

           from RBRQ xFreshR IH have "R'. R ax>  R'  (R', Q'')  bangRel Rel"
             by(metis elim)
           then obtain R' where RTrans: "R ax>  R'" and R'RelQ'': "(R', Q'')  bangRel Rel"
             by blast

           from PTrans RTrans xFreshP have "P  R τ  x>(P'  R')"
             by(rule Early_Semantics.Close1)     
           moreover from P'RelQ' R'RelQ'' have "(x>(P'  R'), x>(Q'  Q''))  bangRel Rel"
             by(force intro: Rel.BRPar BRRes)
           ultimately show "P'. P  R  τ  P'  (P', x>(Q'  Q''))  bangRel Rel" by blast
         qed
      qed
    next
      case(Close2 a x Q' Q'' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (a<x>  Q'')" by simp
      have QTrans: "Q  ax>  Q'" by fact
      have xFreshQ: "x  Q" by fact
      have "(Pa, Q  !Q)  bangRel Rel" and "x  Pa" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝[Rel] Q" by(rule Sim)
          with QTrans xFreshP obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel"
            by(blast dest: elim)

          from RBRQ IH have "R'.  R a<x>  R'  (R', Q'')  bangRel Rel"
            by auto
          then obtain R' where RTrans: "R  a<x>  R'" and R'RelQ'': "(R', Q'')  bangRel Rel"
            by blast

          from PTrans RTrans xFreshR have "P  R  τ  x>(P'  R')"
            by(rule Early_Semantics.Close2)      
          moreover from P'RelQ' R'RelQ'' have "(x>(P'  R'), x>(Q'  Q''))  bangRel Rel"
            by(force intro: Rel.BRPar BRRes)
          ultimately show "P'. P  R  τ  P'  (P', x>(Q'  Q''))  bangRel Rel" by blast
        qed
      qed
    next
      case(Bang Rs Pa P)
      hence IH: "Pa. (Pa, Q  !Q)  bangRel Rel  ?Sim Pa Rs" by simp
      have "(Pa, !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRBangCases)
        case(BRBang P)
        have PRelQ: "(P, Q)  Rel" by fact
        hence "(!P, !Q)  bangRel Rel" by(rule Rel.BRBang)
        with PRelQ have "(P  !P, Q  !Q)  bangRel Rel" by(rule BRPar)
        with IH have "?Sim (P  !P) Rs" by simp
        thus ?case by(force intro: TransitionsEarly.Bang)
      qed
    qed
  }

  moreover from PRelQ have "(!P, !Q)  bangRel Rel" by(rule BRBang) 
  ultimately show ?thesis by(auto simp add: strongSimEarly_def)
qed

end

Theory Strong_Early_Bisim_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Early_Bisim_Pres
  imports Strong_Early_Bisim Strong_Early_Sim_Pres
begin

(************* Preservation rules *************)

lemma tauPres:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"

  shows "τ.(P)  τ.(Q)"
proof -
  let ?X = "{(τ.(P), τ.(Q)) | P Q. P  Q}"
  from P  Q have "(τ.(P), τ.(Q))  ?X" by auto
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto intro: tauPres dest: bisimE)
qed

lemma inputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   x :: name

  assumes PSimQ: "y. P[x::=y]  Q[x::=y]"
  
  shows "a<x>.P  a<x>.Q"
proof -
  let ?X = "{(a<x>.P, a<x>.Q) | a x P Q. y. P[x::=y]  Q[x::=y]}"
  {
    fix axP axQ p
    assume "(axP, axQ)  ?X"
    then obtain a x P Q where A: "y. P[x::=y]  Q[x::=y]" and B: "axP = a<x>.P" and C: "axQ = a<x>.Q"
      by auto
    have "y. ((p::name prm)  P)[(p  x)::=y]  (p  Q)[(p  x)::=y]"
    proof -
      fix y
      from A have "P[x::=(rev p  y)]  Q[x::=(rev p  y)]"
        by blast
      hence "(p  (P[x::=(rev p  y)]))  p  (Q[x::=(rev p  y)])"
        by(rule bisimClosed)
      thus "(p  P)[(p  x)::=y]  (p  Q)[(p  x)::=y]"
        by(simp add: eqvts pt_pi_rev[OF pt_name_inst, OF at_name_inst])
    qed
    hence "((p::name prm)  axP, p  axQ)  ?X" using B C
      by auto
  }
  hence "eqvt ?X" by(simp add: eqvt_def)
  from PSimQ have "(a<x>.P, a<x>.Q)  ?X" by auto
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim P Q)
    thus ?case using ‹eqvt ?X
      by(force intro: inputPres)
  next
    case(cSym P Q)
    thus ?case
      by(blast dest: bisimE)
  qed
qed

lemma outputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "a{b}.P  a{b}.Q"
proof -
  let ?X = "{(a{b}.P, a{b}.Q) | a b P Q. P  Q}"
  from P  Q have "(a{b}.P, a{b}.Q)  ?X" by auto
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (blast intro: outputPres dest: bisimE)+
qed

lemma matchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
proof -
  let ?X = "{x. P Q a b. P  Q  x = ([ab]P, [ab]Q)}"
  from assms have "([ab]P, [ab]Q)  ?X" by blast
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (blast intro: matchPres dest: bisimE)+
qed

lemma mismatchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
proof -
  let ?X = "{x. P Q a b. P  Q  x = ([ab]P, [ab]Q)}"
  from assms have "([ab]P, [ab]Q)  ?X" by blast
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (blast intro: mismatchPres dest: bisimE)+
qed

lemma sumPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  assumes "P  Q"

  shows "P  R  Q  R"
proof -
  let ?X = "{(P  R, Q  R) | P Q R. P  Q}"
  from assms have "(P  R, Q  R)  ?X" by blast
  thus ?thesis
    by(coinduct rule: bisimCoinduct) (auto dest: bisimE intro: reflexive sumPres)
qed

lemma resPres:
  fixes P :: pi
  and   Q :: pi
  and   x :: name
  
  assumes "P  Q"

  shows "x>P  x>Q"
proof -
  let ?X = "{x. P Q. P  Q  (a. x = (a>P, a>Q))}"
  from assms have "(x>P, x>Q)  ?X" by blast
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim xP xQ)
    moreover {
      fix P Q a
      assume "P  Q"
      hence "P ↝[bisim] Q" by(rule bisimE)
      moreover have "P Q a. P  Q  (a>P, a>Q)  ?X  bisim" by blast
      moreover have "bisim  ?X  bisim" by blast
      moreover have "eqvt bisim" by(rule eqvt)
      moreover have "eqvt (?X  bisim)" using eqvts
        by(auto simp add: eqvt_def) blast
      ultimately have "a>P ↝[(?X  bisim)] a>Q"
        by(rule Strong_Early_Sim_Pres.resPres)
    }
    ultimately show ?case by auto
  next
    case(cSym xP xQ)
    thus ?case by(auto dest: bisimE)
  qed
qed

lemma parPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  and   T :: pi

  assumes "P  Q"

  shows "P  R  Q  R"
proof -
  let ?X = "{(resChain lst (P  R), resChain lst (Q  R)) | lst P Q R. P  Q}"
  have BC: "P Q. P  Q = resChain [] (P  Q)" by auto
  from assms have "(P  R, Q  R)  ?X" by(blast intro: BC)
  thus ?thesis
  proof(coinduct rule: bisimWeakCoinduct)
    case(cSim PR QR)
    moreover {
      fix lst P Q R
      assume "P  Q"
      have "eqvt ?X" using eqvts by(auto simp add: eqvt_def) blast
      moreover have Res: "P Q x. (P, Q)  ?X  (x>P, x>Q)  ?X"
        by(auto, rule_tac x="x#lst" in exI) auto
      moreover {
        from P  Q have "P ↝[bisim] Q" by(rule bisimE)
        moreover note P  Q
        moreover have "P Q R. P  Q  (P  R, Q  R)  ?X"
          by(blast intro: BC)
        ultimately have "P  R ↝[?X] Q  R" using Res
          by(rule parPres)
      }

      ultimately have "resChain lst (P  R) ↝[?X] resChain lst (Q  R)"
        by(rule resChainI)
    }
    ultimately show ?case by auto
  next
    case(cSym P Q)
    thus ?case by(auto dest: bisimE)
  qed
qed

lemma bangRelBisimE: 
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"

  assumes A:   "(P, Q)  bangRel Rel"
  and     Sym: "P Q. (P, Q)  Rel  (Q, P)  Rel"

  shows "(Q, P)  bangRel Rel"
proof -
  from A show ?thesis
  proof(induct)
    fix P Q
    assume "(P, Q)  Rel"
    hence "(Q, P)  Rel" by(rule Sym)
    thus "(!Q, !P)  bangRel Rel" by(rule BRBang)
  next
    fix P Q R T
    assume RRelT: "(R, T)  Rel"
    assume IH: "(Q, P)  bangRel Rel"
    from RRelT have "(T, R)  Rel" by(rule Sym)
    thus "(T  Q, R  P)  bangRel Rel" using IH by(rule BRPar)
  next
    fix P Q a
    assume "(Q, P)  bangRel Rel"
    thus "(a>Q, a>P)  bangRel Rel" by(rule BRRes)
  qed
qed

lemma bangPres:
  fixes P :: pi
  and   Q :: pi

  assumes PBiSimQ: "P  Q"

  shows "!P  !Q"
proof -
  let ?X = "bangRel bisim"
    from PBiSimQ have "(!P, !Q)  ?X" by(rule BRBang)
    thus ?thesis
    proof(coinduct rule: bisimWeakCoinduct)
      case(cSim bP bQ)
      {
        fix P Q
        assume "(P, Q)  ?X"
        hence "P ↝[?X] Q"
        proof(induct)
          fix P Q
          assume "P  Q"
          thus "!P ↝[?X] !Q" using bisimE(1) eqvt
            by(rule Strong_Early_Sim_Pres.bangPres)
        next
          fix P Q R T
          assume RBiSimT: "R  T"
          assume PBangRelQ: "(P, Q)  ?X"
          assume PSimQ: "P ↝[?X] Q"
          from RBiSimT  have "R ↝[bisim] T" by(blast dest: bisimE)
          thus "R  P ↝[?X] T  Q" using PSimQ RBiSimT PBangRelQ BRPar BRRes eqvt eqvtBangRel
            by(blast intro: Strong_Early_Sim_Pres.parCompose)
        next
          fix P Q a
          assume "P ↝[?X] Q"
          moreover from eqvtBangRel eqvt have "eqvt ?X" by blast 
          ultimately show "a>P ↝[?X] a>Q" using BRRes by(blast intro: Strong_Early_Sim_Pres.resPres)
        qed
      }
      with (bP, bQ)  ?X show ?case by blast
    next
      case(cSym bP bQ)
      thus ?case by(metis bangRelSymetric bisimE)
  qed
qed

end

Theory Strong_Early_Bisim_Subst_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Early_Bisim_Subst_Pres
  imports Strong_Early_Bisim_Subst Strong_Early_Bisim_Pres
begin

lemma tauPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "τ.(P) s τ.(Q)"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.tauPres)

lemma inputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   x :: name

  assumes "P s Q"

  shows "a<x>.P s a<x>.Q"
proof(auto simp add: substClosed_def)
  fix σ :: "(name × name) list"
  {
    fix P Q a x σ
    assume "P s Q"
    then have "P[<σ>] s Q[<σ>]" by(rule partUnfold)
    then have "y. (P[<σ>])[x::=y]  (Q[<σ>])[x::=y]"
      apply(auto simp add: substClosed_def)
      by(erule_tac x="[(x, y)]" in allE) auto
    moreover assume "x  σ"
    ultimately have "(a<x>.P)[<σ>]  (a<x>.Q)[<σ>]" 
      by(force intro: Strong_Early_Bisim_Pres.inputPres)
  }
  note Goal = this

  obtain y::name where "y  P" and "y  Q" and "y  σ"
    by(generate_fresh "name") auto
  from P s Q have "([(x, y)]  P) s ([(x, y)]  Q)" by(rule eqvtI)
  hence "(a<y>.([(x, y)]  P))[<σ>]  (a<y>.([(x, y)]  Q))[<σ>]" using y  σ by(rule Goal)
  moreover from y  P y  Q have "a<x>.P = a<y>.([(x, y)]  P)" and "a<x>.Q = a<y>.([(x, y)]  Q)"
    by(simp add: alphaInput)+

  ultimately show "(a<x>.P)[<σ>]  (a<x>.Q)[<σ>]" by simp
qed

lemma outputPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "a{b}.P s a{b}.Q"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.outputPres)

lemma matchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P s Q"

  shows "[ab]P s [ab]Q"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.matchPres)

lemma mismatchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P s Q"

  shows "[ab]P s [ab]Q"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.mismatchPres)

lemma sumPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P s Q"

  shows "P  R s Q  R"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.sumPres)

lemma parPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P s Q"

  shows "P  R s Q  R"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.parPres)

lemma resPres:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes PeqQ: "P s Q"
  
  shows "x>P s x>Q"
proof(auto simp add: substClosed_def)
  fix s::"(name × name) list"

  have Res: "P Q x s. P[<s>]  Q[<s>]; x  s  (x>P)[<s>]  (x>Q)[<s>]"
    by(force intro: Strong_Early_Bisim_Pres.resPres)

  have "c::name. c  (P, Q, s)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshQ: "c  Q" and cFreshs: "c  s"
    by(force simp add: fresh_prod)

  from PeqQ have "P[<([(x, c)]  s)>]  Q[<([(x, c)]  s)>]" by(simp add: substClosed_def)
  hence "([(x, c)]  P[<([(x, c)]  s)>])  ([(x, c)]  Q[<([(x, c)]  s)>])" by(rule Strong_Early_Bisim.bisimClosed)
  hence "([(x, c)]  P)[<s>]  ([(x, c)]  Q)[<s>]" by simp
  hence "(c>([(x, c)]  P))[<s>]  (c>([(x, c)]  Q))[<s>]" using cFreshs by(rule Res)

  moreover from cFreshP cFreshQ have "x>P = c>([(x, c)]  P)" and "x>Q = c>([(x, c)]  Q)"
    by(simp add: alphaRes)+

  ultimately show "(x>P)[<s>]  (x>Q)[<s>]" by simp
qed

lemma bangPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "!P s !Q"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.bangPres)

end

Theory Early_Tau_Chain

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Early_Tau_Chain
  imports Early_Semantics
begin

abbreviation tauChain :: "pi  pi  bool" ("_ τ _" [80, 80] 80)
  where "P τ P'  (P, P')  {(P, P') | P P'. P τ  P'}^*"

lemma tauActTauChain:
  fixes P  :: pi
  and   P' :: pi

  assumes "P τ  P'"

  shows "P τ P'"
using assms
by auto

lemma tauChainAddTau[intro]:
  fixes P   :: pi
  and   P'  :: pi
  and   P'' :: pi

  shows "P τ P'  P' τ  P''  P τ P''" 
  and "P τ  P'  P' τ P''  P τ P''"
by(auto dest: tauActTauChain)

lemma tauChainInduct[consumes 1, case_names id ih]:
  fixes P  :: pi
  and   P' :: pi

  assumes "P τ P'"
  and     "F P"
  and     "P'' P'''. P τ P''; P'' τ  P'''; F P''  F P'''"

  shows "F P'"
using assms
by(drule_tac rtrancl_induct) auto

lemma eqvtChainI:
  fixes P    :: pi
  and   P'   :: pi
  and   perm :: "name prm"

  assumes "P τ P'"

  shows "(perm  P) τ (perm  P')"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P'' P''')
  have "P τ P''" and "P''  τ  P'''" by fact+
  hence "(perm  P'') τ  (perm  P''')" by(drule_tac TransitionsEarly.eqvt) auto
  moreover have "(perm  P) τ (perm  P'')" by fact
  ultimately show ?case by(force dest: tauActTauChain)
qed

lemma eqvtChainE:
  fixes perm :: "name prm"
  and   P    :: pi
  and   P'   :: pi

  assumes Trans: "(perm  P) τ (perm  P')"

  shows   "P τ P'"
proof -
  have "rev perm  (perm  P) = P" by(simp add: pt_rev_pi[OF pt_name_inst, OF at_name_inst])
  moreover have "rev perm  (perm  P') = P'" by(simp add: pt_rev_pi[OF pt_name_inst, OF at_name_inst])
  ultimately show ?thesis using assms
    by(drule_tac perm="rev perm" in eqvtChainI, simp)
qed

lemma eqvtChainEq:
  fixes P    :: pi
  and   P'   :: pi
  and   perm :: "name prm"

  shows   "P τ P' = (perm  P) τ (perm  P')"
by(blast intro: eqvtChainE eqvtChainI)

lemma freshChain:
  fixes P  :: pi
  and   P' :: pi
  and   x  :: name
  
  assumes "P τ P'"
  and     "x  P"
 
  shows   "x  P'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P' P'')
  have "x  P" and "x  P  x  P'" by fact+
  hence "x  P'" by simp
  moreover have "P'  τ  P''" by fact
  ultimately show ?case by(force intro: freshTransition)
qed

lemma matchChain:
  fixes b :: name
  and   P :: pi
  and   P' :: pi
  
  assumes "P τ P'"
  and     "P  P'"
 
  shows "[bb]P τ P'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P'' P''')
  have P''TransP''':  "P'' τ  P'''"  by fact
  show "[bb]P τ P'''" 
  proof(cases "P = P''")
    assume "P=P''"
    moreover with P''TransP''' have "[bb]P τ  P'''" by(force intro: Match)
    thus "[bb]P τ P'''" by(rule tauActTauChain)
  next
    assume "P  P''"
    moreover have "P  P''  [bb]P τ P''" by fact
    ultimately show "[bb]P τ P'''" using P''TransP''' by(blast)
  qed
qed

lemma mismatchChain:
  fixes a :: name
  and   b :: name
  and   P :: pi
  and   P' :: pi
  
  assumes PChain: "P τ P'"
  and     aineqb: "a  b"
  and     PineqP': "P  P'"
 
  shows "[ab]P τ P'"
proof -
  from PChain PineqP' show ?thesis
  proof(induct rule: tauChainInduct)
    case id
    thus ?case by simp
  next
    case(ih P'' P''')
    have P''TransP''':  "P'' τ  P'''"  by fact
    show "[ab]P τ P'''" 
    proof(cases "P = P''")
      assume "P=P''"
      moreover with aineqb P''TransP''' have "[ab]P τ  P'''" by(force intro: Mismatch)
      thus "[ab]P τ P'''" by(rule tauActTauChain)
    next
      assume "P  P''"
      moreover have "P  P''  [ab]P τ P''" by fact
      ultimately show "[ab]P τ P'''" using P''TransP''' by(blast)
    qed
  qed
qed

lemma sum1Chain:
  fixes P  :: pi
  and   P' :: pi
  and   Q  :: pi

  assumes "P τ P'"
  and     "P  P'"
 
  shows "P  Q τ P'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P'' P''')
  have P''TransP''':  "P'' τ  P'''" by fact
  show "P  Q τ P'''"
  proof(cases "P = P''")
    assume "P=P''"
    moreover with P''TransP''' have "P  Q τ  P'''" by(force intro: Sum1)
    thus "P  Q τ P'''" by(force intro: tauActTauChain)
  next
    assume "P  P''"
    moreover have "P  P''  P  Q τ P''" by fact
    ultimately show "P  Q τ P'''" using P''TransP''' by(force dest: tauActTauChain)
  qed
qed

lemma sum2Chain:
  fixes P  :: pi
  and   Q :: pi
  and   Q'  :: pi

  assumes "Q τ Q'"
  and     "Q  Q'"
 
  shows "P  Q τ Q'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih Q'' Q''')
  have Q''TransQ''':  "Q'' τ  Q'''" by fact
  show "P  Q τ Q'''"
  proof(cases "Q = Q''")
    assume "Q=Q''"
    moreover with Q''TransQ''' have "P  Q τ  Q'''" by(force intro: Sum2)
    thus "P  Q τ Q'''" by(force intro: tauActTauChain)
  next
    assume "Q  Q''"
    moreover have "Q  Q''  P  Q τ Q''" by fact
    ultimately show "P  Q τ Q'''" using Q''TransQ''' by blast
  qed
qed

lemma Par1Chain:
  fixes P  :: pi
  and   P' :: pi
  and   Q  :: pi

  assumes "P τ P'"

  shows "P  Q τ P'  Q"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P'' P')
  have P''TransP':  "P'' τ  P'" by fact
  have IH: "P  Q τ P''  Q" by fact
  
  have "P''  Q τ  P'  Q" using P''TransP' by(force intro: Par1F)
  thus "P  Q τ P'  Q" using IH by(force dest: tauActTauChain)
qed

lemma Par2Chain:
  fixes P  :: pi
  and   Q  :: pi
  and   Q' :: pi

  assumes "Q τ Q'"

  shows "P  Q τ P  Q'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih Q'' Q')
  have Q''TransQ':  "Q'' τ  Q'" by fact
  have IH: "P  Q τ P  Q''" by fact
  
  have "P  Q'' τ  P  Q'" using Q''TransQ' by(force intro: Par2F)
  thus "P  Q τ P  Q'" using IH by(force dest: tauActTauChain)
qed

lemma chainPar:
  fixes P  :: pi
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi
  
  assumes "P τ P'"
  and     "Q τ Q'"

  shows "P  Q τ P'  Q'"
proof -
  from P τ P' have "P  Q τ P'  Q" by(rule Par1Chain)
  moreover from Q τ Q' have "P'  Q τ P'  Q'" by(rule Par2Chain)
  ultimately show ?thesis by auto
qed

lemma ResChain:
  fixes P  :: pi
  and   P' :: pi
  and   a  :: name

  assumes "P τ P'"

  shows "a>P τ a>P'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P'' P''')
  have "P'' τ  P'''" by fact
  hence "a>P'' τ  a>P'''" by(force intro: ResF)
  moreover have "a>P τ a>P''" by fact
  ultimately show ?case by(force dest: tauActTauChain)
qed

lemma substChain:
  fixes P  :: pi
  and   x  :: name
  and   b  :: name
  and   P' :: pi

  assumes PTrans: "P[x::=b] τ P'"

  shows "P[x::=b] τ P'[x::=b]"
proof(cases "x=b")
  assume "x = b"
  with PTrans show ?thesis by simp
next
  assume "x  b"
  hence "x  P[x::=b]" by(simp add: fresh_fact2)
  with PTrans have "x  P'" by(force intro: freshChain)
  hence "P' = P'[x::=b]" by(simp add: forget)
  with PTrans show ?thesis by simp
qed

lemma bangChain:
  fixes P  :: pi
  and   P' :: pi

  assumes PTrans: "P  !P τ P'"
  and     P'ineq: "P'  P  !P"

  shows "!P τ P'"
using assms
proof(induct rule: tauChainInduct)
  case id
  thus ?case by simp
next
  case(ih P' P'')
  show ?case
  proof(cases "P' = P  !P")
    case True
    from P' τ  P'' P' = P  !P have "!P τ  P''" by(blast intro: Bang)
    thus ?thesis by auto
  next
    case False
    from P'  P  !P have "!P τ P'" by(rule ih)
    with P' τ  P'' show ?thesis by(auto dest: tauActTauChain)
  qed
qed

end

Theory Weak_Early_Step_Semantics

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Step_Semantics
  imports Early_Tau_Chain
begin

lemma inputSupportDerivative:
  assumes "P a<x>  P'"

  shows "(supp P') - {x}  supp P"
using assms
apply(nominal_induct rule: inputInduct)
apply(auto simp add: pi.supp abs_supp supp_atm)
apply(rule ccontr)
apply(simp add: fresh_def[symmetric])
apply(drule_tac fresh_fact1)
apply(rotate_tac 4)
apply assumption
apply(simp add: fresh_def)
apply force
apply(case_tac "x  P")
apply(drule_tac fresh_fact1)
apply(rotate_tac 2)
apply assumption
apply(simp add: fresh_def)
apply force
apply(rotate_tac 2)
apply(drule_tac fresh_fact2)
apply(simp add: fresh_def)
by force

lemma outputSupportDerivative:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes "P a[b]  P'"

  shows "(supp P')  ((supp P)::name set)"
using assms
by(nominal_induct rule: outputInduct) (auto simp add: pi.supp abs_supp)

lemma boundOutputSupportDerivative:
  assumes "P ax>  P'"
  and     "x  P"

  shows "(supp P') - {x}  supp P"
using assms
by(nominal_induct rule: boundOutputInduct) (auto simp add: pi.supp abs_supp supp_atm dest: outputSupportDerivative)

lemma tauSupportDerivative: 

  assumes "P τ  P'"

  shows "((supp P')::name set)  supp P"
using assms
proof(nominal_induct rule: tauInduct)
  case(Tau P)
  thus ?case by(force simp add: pi.supp)
next
  case(Match P)
  thus ?case by(force simp add: pi.supp)
next
  case(Mismatch P)
  thus ?case by(force simp add: pi.supp)
next
  case(Sum1 P)
  thus ?case by(force simp add: pi.supp)
next
  case(Sum2 P)
  thus ?case by(force simp add: pi.supp)
next
  case(Par1 P)
  thus ?case by(force simp add: pi.supp)
next
  case(Par2 P)
  thus ?case by(force simp add: pi.supp)
next
  case(Comm1 P a b P' Q Q')
  from P a<b>  P' have "(supp P') - {b}  supp P" by(rule inputSupportDerivative)
  moreover from Q  a[b]  Q' have "((supp Q')::name set)  supp Q" by(rule outputSupportDerivative)
  moreover from Q  a[b]  Q' have "b  supp Q"
    by(nominal_induct rule: outputInduct) (auto simp add: pi.supp abs_supp supp_atm)
  ultimately show ?case by(auto simp add: pi.supp)
next
  case(Comm2 P a b P' Q Q')
  from P  a[b]  P' have "((supp P')::name set)  supp P" by(rule outputSupportDerivative)
  moreover from Q a<b>  Q' have "(supp Q') - {b}  supp Q" by(rule inputSupportDerivative)
  moreover from P  a[b]  P' have "b  supp P"
    by(nominal_induct rule: outputInduct) (auto simp add: pi.supp abs_supp supp_atm)
  ultimately show ?case by(auto simp add: pi.supp)
next
  case(Close1 P a x P' Q Q')
  thus ?case by(auto dest: inputSupportDerivative boundOutputSupportDerivative simp add: abs_supp pi.supp)
next
  case(Close2 P a x P' Q Q')
  thus ?case by(auto dest: inputSupportDerivative boundOutputSupportDerivative simp add: abs_supp pi.supp)
next
  case(Res P P' x)
  thus ?case by(force simp add: pi.supp abs_supp)
next
  case(Bang P P')
  thus ?case by(force simp add: pi.supp)
qed

lemma tauChainSupportDerivative:
  fixes P  :: pi
  and   P' :: pi

  assumes "P τ P'"

  shows "((supp P')::name set)  (supp P)"
using assms
by(induct rule: tauChainInduct) (auto dest: tauSupportDerivative)

definition outputTransition :: "pi  name  name  pi  bool" ("_ __>  _" [80, 80, 80, 80] 80)
  where "P ax>  P'  P''' P''. P τ P'''  P''' ax>  P''  P'' τ P'"

definition freeTransition :: "pi  freeRes pi  bool" ("_ _  _" [80, 80, 80] 80)
  where "P α  P'  P''' P''. P τ P'''  P''' α  P''  P'' τ P'"

lemma transitionI:
  fixes P    :: pi
  and   P''' :: pi
  and   α    :: freeRes
  and   P''  :: pi
  and   P'   :: pi
  and   a    :: name
  and   x    :: name

  shows "P τ P'''; P''' α  P''; P'' τ P'  P α  P'"
  and   "P τ P'''; P''' ax>  P''; P'' τ P'  P ax>  P'"
by(auto simp add: outputTransition_def freeTransition_def)

lemma transitionE:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   a  :: name
  and   x  :: name

  shows "P α  P'  (P'' P'''. P τ P''  P'' α  P'''  P''' τ P')" 
  and   "P ax>  P'  P'' P'''. P τ P'''  P''' ax>  P''  P'' τ P'"
by(auto simp add: outputTransition_def freeTransition_def)

lemma weakTransitionAlpha:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   y  :: name

  assumes PTrans: "P ax>  P'"
  and     "y  P"

  shows "P ay>  ([(x, y)]  P')"
proof(cases "y=x")
  case True
  with PTrans show ?thesis by simp
next
  case False
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' ax>  P''"
                                and P''Chain: "P'' τ P'"
    by(force dest: transitionE)
  note PChain 
  moreover from PChain y  P have "y  P'''" by(rule freshChain)
  with P'''Trans have "y  P''" using y  x by(rule freshTransition)
  with P'''Trans have "P''' ay>  ([(x, y)]  P'')" by(simp add: alphaBoundOutput name_swap)
  moreover from P''Chain have "([(x, y)]  P'') τ ([(x, y)]  P')"
    by(rule eqvtChainI)
  ultimately show ?thesis by(rule transitionI)
qed

lemma singleActionChain:
  fixes P  :: pi
  and   Rs :: residual

  shows "P ax>  P'  P ax>  P'"
  and   "P α  P'  P α  P'"
proof -
  have "P τ P" by simp
  moreover assume "P ax>  P'"
  moreover have "P' τ P'" by simp
  ultimately show "P ax>  P'"
    by(rule transitionI)
next
  have "P τ P" by simp
  moreover assume "P α  P'"
  moreover have "P' τ P'" by simp
  ultimately show "P α  P'"
    by(rule transitionI)
qed

lemma Tau:
  fixes P :: pi

  shows "τ.(P)  τ   P"
proof -
  have "τ.(P) τ τ.(P)" by simp
  moreover have "τ.(P) τ  P" by(rule Early_Semantics.Tau)
  moreover have "P τ P" by simp
  ultimately show ?thesis by(rule transitionI)
qed

lemma Input:
  fixes a :: name
  and   x :: name
  and   u :: name
  and   P :: pi

  shows "a<x>.P  a<u>  P[x::=u]"
proof -
  have "a<x>.P τ a<x>.P" by simp
  moreover have "a<x>.P  a<u>  P[x::=u]" by(rule Early_Semantics.Input)
  moreover have "P[x::=u] τ P[x::=u]" by simp
  ultimately show ?thesis by(rule transitionI)
qed
  
lemma Output:
  fixes a :: name
  and   b :: name
  and   P :: pi

  shows "a{b}.P a[b]  P"
proof -
  have "a{b}.P τ a{b}.P" by simp
  moreover have "a{b}.P a[b]  P" by(rule Early_Semantics.Output)
  moreover have "P τ P" by simp
  ultimately show ?thesis by(rule transitionI)
qed

lemma Match:
  fixes P  :: pi
  and   b  :: name
  and   x  :: name
  and   a  :: name
  and   P' :: pi
  and   α :: freeRes

  shows "P bx>  P'  [aa]P bx>  P'"
  and   "P α  P'  [aa]P α  P'"
proof -
  assume "P  bx>  P'" 
  then obtain P'' P''' where PChain: "P τ P'''"
                         and P'''Trans: "P''' bx>  P''"
                         and P''Chain: "P'' τ P'"
    by(force dest: transitionE)
  show "[aa]P bx>  P'"
  proof(cases "P = P'''")
    case True
    have "[aa]P τ [aa]P" by simp
    moreover from P = P''' P'''Trans have "[aa]P  bx>  P''"
      by(rule_tac Early_Semantics.Match) auto
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain P  P''' have "[aa]P τ P'''" by(rule matchChain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
next
  assume "P α  P'" 
  then obtain P'' P''' where PChain: "P τ P'''"
                         and P'''Trans: "P''' α  P''"
                         and P''Chain: "P'' τ P'"
    by(force dest: transitionE)
  show "[aa]P α  P'"
  proof(cases "P = P'''")
    case True
    have "[aa]P τ [aa]P" by simp
    moreover from P = P''' P'''Trans have "[aa]P α  P''"
      by(rule_tac Early_Semantics.Match) auto
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain P  P''' have "[aa]P τ P'''" by(rule matchChain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
qed
                              
lemma Mismatch:
  fixes P  :: pi
  and   c  :: name
  and   x  :: name
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   α :: freeRes

  shows "P cx>  P'; a  b  [ab]P cx>  P'"
  and   "P α  P'; a  b  [ab]P α  P'"
proof -
  assume "P cx>  P'" 
  then obtain P'' P''' where PChain: "P τ P'''"
                         and P'''Trans: "P''' cx>  P''"
                         and P''Chain: "P'' τ P'"
    by(force dest: transitionE)
  assume "a  b"
  show "[ab]P cx>  P'"
  proof(cases "P = P'''")
    case True
    have "[ab]P τ [ab]P" by simp
    moreover from P = P''' a  b P'''Trans have "[ab]P  cx>  P''"
      by(rule_tac Early_Semantics.Mismatch) auto
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain a  b P  P''' have "[ab]P τ P'''" by(rule mismatchChain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
next
  assume "P α  P'" 
  then obtain P'' P''' where PChain: "P τ P'''"
                         and P'''Trans: "P''' α  P''"
                         and P''Chain: "P'' τ P'"
    by(force dest: transitionE)
  assume "a  b"
  show "[ab]P α  P'"
  proof(cases "P = P'''")
    case True
    have "[ab]P τ [ab]P" by simp
    moreover from P = P''' a  b P'''Trans have "[ab]P α  P''"
      by(rule_tac Early_Semantics.Mismatch) auto
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain a  b P  P''' have "[ab]P τ P'''" by(rule mismatchChain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
qed
                              
lemma Open:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes PTrans:  "P a[b]  P'"
  and     "a  b"

  shows "b>P ab>  P'"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' a[b]  P''"
                                and P''Chain: "P'' τ P'"
    by(force dest: transitionE)
  from PChain have "b>P τ b>P'''" by(rule ResChain)
  moreover from P'''Trans a  b have "b>P''' ab>  P''" by(rule Open)
  ultimately show ?thesis using P''Chain by(rule transitionI)
qed

lemma Sum1:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   α  :: freeRes

  shows "P ax>  P'  P  Q ax>  P'"
  and   "P α  P'  P  Q α  P'"
proof -
  assume "P ax>  P'"
  then obtain P'' P''' where PChain: "P τ P'''"
                         and P'''Trans: "P''' ax>  P''"
                         and P''Chain: "P'' τ P'"
    by(force dest: transitionE)
  show "P  Q ax>  P'"
  proof(cases "P = P'''")
    case True
    have "P  Q τ P  Q" by simp
    moreover from P'''Trans P = P''' have "P  Q  ax>  P''" by(blast intro: Sum1)
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain P  P''' have "P  Q τ P'''" by(rule sum1Chain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
next
  assume "P α  P'"
  then obtain P'' P''' where PChain: "P τ P'''"
                         and P'''Trans: "P''' α  P''"
                         and P''Chain: "P'' τ P'"
    by(force dest: transitionE)
  show "P  Q α  P'"
  proof(cases "P = P'''")
    case True
    have "P  Q τ P  Q" by simp
    moreover from P'''Trans P = P''' have "P  Q α  P''" by(blast intro: Sum1)
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain P  P''' have "P  Q τ P'''" by(rule sum1Chain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
qed

lemma Sum2:
  fixes Q  :: pi
  and   a  :: name
  and   x  :: name
  and   Q' :: pi
  and   P  :: pi
  and   α  :: freeRes

  shows "Q ax>  Q'  P  Q ax>  Q'"
  and   "Q α  Q'  P  Q α  Q'"
proof -
  assume "Q ax>  Q'"
  then obtain Q'' Q''' where QChain: "Q τ Q'''"
                         and Q'''Trans: "Q''' ax>  Q''"
                         and Q''Chain: "Q'' τ Q'"
    by(force dest: transitionE)
  show "P  Q ax>  Q'"
  proof(cases "Q = Q'''")
    case True
    have "P  Q τ P  Q" by simp
    moreover from Q'''Trans Q = Q''' have "P  Q ax>  Q''" by(blast intro: Sum2)
    ultimately show ?thesis using Q''Chain by(rule transitionI)
  next
    case False
    from QChain Q  Q''' have "P  Q τ Q'''" by(rule sum2Chain)
    thus ?thesis using Q'''Trans Q''Chain by(rule transitionI)
  qed
next
  assume "Q α  Q'"
  then obtain Q'' Q''' where QChain: "Q τ Q'''"
                         and Q'''Trans: "Q''' α  Q''"
                         and Q''Chain: "Q'' τ Q'"
    by(force dest: transitionE)
  show "P  Q α  Q'"
  proof(cases "Q = Q'''")
    case True
    have "P  Q τ P  Q" by simp
    moreover from Q'''Trans Q = Q''' have "P  Q α  Q''" by(blast intro: Sum2)
    ultimately show ?thesis using Q''Chain by(rule transitionI)
  next
    case False
    from QChain Q  Q''' have "P  Q τ Q'''" by(rule sum2Chain)
    thus ?thesis using Q'''Trans Q''Chain by(rule transitionI)
  qed
qed

lemma Par1B:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi

  assumes PTrans: "P ax>  P'"
  and     "x  Q"

  shows "P  Q ax>  (P'  Q)"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' ax>  P''"
                                and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)
  from PChain have "P  Q τ P'''  Q" by(rule Par1Chain)
  moreover from P'''Trans x  Q have "P'''  Q ax>  (P''  Q)" by(rule Early_Semantics.Par1B)
  moreover from P''Chain have "P''  Q τ P'  Q" by(rule Par1Chain)
  ultimately show "P  Q ax>  (P'  Q)" by(rule transitionI)
qed

lemma Par1F:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   Q  :: pi

  assumes PTrans: "P α  P'"

  shows "P  Q α  (P'  Q)"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' α  P''"
                                and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)
  from PChain have "P  Q τ P'''  Q" by(rule Par1Chain)
  moreover from P'''Trans have "P'''  Q α  (P''  Q)" by(rule Early_Semantics.Par1F)
  moreover from P''Chain have "P''  Q τ P'  Q" by(rule Par1Chain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Par2B:
  fixes Q  :: pi
  and   a  :: name
  and   x  :: name
  and   Q' :: pi
  and   P  :: pi

  assumes QTrans: "Q ax>  Q'"
  and     "x  P"

  shows "P  Q ax>  (P  Q')"
proof -
  from QTrans obtain Q'' Q''' where QChain: "Q τ Q'''"
                                and Q'''Trans: "Q''' ax>  Q''"
                                and Q''Chain: "Q'' τ Q'"
    by(blast dest: transitionE)
  from QChain have "P  Q τ P  Q'''" by(rule Par2Chain)
  moreover from Q'''Trans x  P have "P  Q''' ax>  (P  Q'')" by(rule Early_Semantics.Par2B)
  moreover from Q''Chain have "P  Q'' τ P  Q'" by(rule Par2Chain)
  ultimately show "P  Q ax>  (P  Q')" by(rule transitionI)
qed

lemma Par2F:
  fixes Q  :: pi
  and   α  :: freeRes
  and   Q' :: pi
  and   P  :: pi

  assumes QTrans: "Q α  Q'"

  shows "P  Q α  (P  Q')"
proof -
  from QTrans obtain Q'' Q''' where QChain: "Q τ Q'''"
                                and Q'''Trans: "Q''' α  Q''"
                                and Q''Chain: "Q'' τ Q'"
    by(blast dest: transitionE)
  from QChain have "P  Q τ P  Q'''" by(rule Par2Chain)
  moreover from Q'''Trans have "P  Q''' α  (P  Q'')" by(rule Early_Semantics.Par2F)
  moreover from Q''Chain have "P  Q'' τ P  Q'" by(rule Par2Chain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Comm1:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi
  
  assumes PTrans: "P a<b>  P'"
  and     QTrans: "Q a[b]  Q'"

  shows "P  Q τ  P'  Q'"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' a<b>  P''"
                                and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)
  from QTrans obtain Q'' Q''' where QChain: "Q τ Q'''"
                                and Q'''Trans: "Q''' a[b]  Q''"
                                and Q''Chain: "Q'' τ Q'"
    by(blast dest: transitionE)

  from PChain QChain have "P  Q τ P'''  Q'''" by(rule chainPar)
  moreover from P'''Trans Q'''Trans have "P'''  Q''' τ  P''  Q''"
    by(rule Early_Semantics.Comm1)
  moreover from P''Chain Q''Chain have "P''  Q'' τ P'  Q'" by(rule chainPar)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Comm2:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi
  
  assumes PTrans: "P a[b]  P'"
  and     QTrans: "Q a<b>  Q'"

  shows "P  Q τ  P'  Q'"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' a[b]  P''"
                                and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)
  from QTrans obtain Q'' Q''' where QChain: "Q τ Q'''"
                                and Q'''Trans: "Q''' a<b>  Q''"
                                and Q''Chain: "Q'' τ Q'"
    by(blast dest: transitionE)

  from PChain QChain have "P  Q τ P'''  Q'''" by(rule chainPar)
  moreover from P'''Trans Q'''Trans have "P'''  Q''' τ  P''  Q''"
    by(rule Early_Semantics.Comm2)
  moreover from P''Chain Q''Chain have "P''  Q'' τ P'  Q'" by(rule chainPar)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Close1:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi
  
  assumes PTrans: "P a<x>  P'"
  and     QTrans: "Q ax>  Q'"
  and     "x  P"

  shows "P  Q τ  x>(P'  Q')"
proof -
  from PTrans obtain P''' P'' where PChain: "P τ P'''"
                                and P'''Trans: "P''' a<x>  P''"
                                and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)
  from QTrans obtain Q'' Q''' where QChain: "Q τ Q'''"
                                and Q'''Trans: "Q''' ax>  Q''"
                                and Q''Chain: "Q'' τ Q'"
    by(blast dest: transitionE)


  from PChain QChain have "P  Q τ P'''  Q'''" by(rule chainPar)
  moreover from PChain x  P have "x  P'''" by(rule freshChain)
  with P'''Trans Q'''Trans have "P'''  Q''' τ  x>(P''  Q'')"
    by(rule Early_Semantics.Close1)
  moreover from P''Chain Q''Chain have "P''  Q'' τ P'  Q'" by(rule chainPar)
  hence "x>(P''  Q'') τ x>(P'  Q')" by(rule ResChain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Close2:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi
  
  assumes PTrans: "P ax>  P'"
  and     QTrans: "Q a<x>  Q'"
  and     xFreshQ: "x  Q"

  shows "P  Q τ  x>(P'  Q')"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' ax>  P''"
                                and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)
  from QTrans obtain Q'' Q''' where QChain: "Q τ Q'''"
                                and Q'''Trans: "Q''' a<x>  Q''"
                                and Q''Chain: "Q'' τ Q'"
    by(blast dest: transitionE)

  from PChain QChain have "P  Q τ P'''  Q'''" by(rule chainPar)
  moreover from QChain x  Q have "x  Q'''" by(rule freshChain)

  with P'''Trans Q'''Trans have "P'''  Q''' τ  x>(P''  Q'')"
    by(rule Early_Semantics.Close2)
  moreover from P''Chain Q''Chain have "P''  Q'' τ P'  Q'" by(rule chainPar)
 hence "x>(P''  Q'') τ x>(P'  Q')" by(rule ResChain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma ResF:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   x  :: name

  assumes PTrans: "P α  P'"
  and     "x  α"

  shows "x>P α  x>P'"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' α  P''"
                                and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)

  from PChain have "x>P τ x>P'''" by(rule ResChain)
  moreover from P'''Trans x  α have "x>P''' α  x>P''"
    by(rule Early_Semantics.ResF)
  moreover from P''Chain have "x>P'' τ x>P'" by(rule ResChain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma ResB:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   y  :: name

  assumes PTrans: "P ax>  P'"
  and     "y  a"
  and     "y  x"

  shows "y>P ax>  (y>P')"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' ax>  P''"
                                and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)

  from PChain have "y>P τ y>P'''" by(rule ResChain)
  moreover from P'''Trans  y  a y  x have "y>P''' ax>  (y>P'')"
    by(rule Early_Semantics.ResB)
  moreover from P''Chain have "y>P'' τ y>P'" by(rule ResChain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Bang:
  fixes P  :: pi
  and   Rs :: residual


  shows "P  !P ax>  P'  !P ax>  P'"
  and   "P  !P α  P'  !P α  P'"
proof -
  assume PTrans: "P  !P  ax>  P'"

  from PTrans obtain P'' P''' where PChain: "P  !P τ P'''"
                                and P'''Trans: "P''' ax>  P''"
                                and P''Chain: "P'' τ P'"
    by(force dest: transitionE)
  
  show "!P ax>  P'"
  proof(cases "P''' = P  !P")
    case True
    have "!P τ !P" by simp
    moreover from P'''Trans P''' = P  !P have "!P ax>  P''" by(blast intro: Early_Semantics.Bang)
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain P'''  P  !P have "!P τ P'''" by(rule bangChain)
    with P'''Trans P''Chain show ?thesis by(blast intro: transitionI)
  qed
next
  fix α P' P
  assume "P  !P α  P'"
    
  then obtain P'' P''' where PChain: "P  !P τ P''"
                         and P''Trans: "P'' α  P'''"
                         and P'''Chain: "P''' τ P'"
    by(force dest: transitionE)

  show "!P α  P'"
  proof(cases "P'' = P  !P")
    assume "P'' = P  !P"
    moreover with P''Trans have "!P α  P'''" by(blast intro: Bang)
    ultimately show ?thesis using PChain P'''Chain by(rule_tac transitionI, auto)
  next
    assume "P''  P  !P"
    with PChain have "!P τ P''" by(rule bangChain)
    with P''Trans P'''Chain show ?thesis by(blast intro: transitionI)
  qed
qed

lemma tauTransitionChain:
  fixes P  :: pi
  and   P' :: pi

  assumes "P τ  P'"

  shows "P τ P'"
using assms
by(force dest: transitionE tauActTauChain)

lemma chainTransitionAppend:
  fixes P   :: pi
  and   P'  :: pi
  and   Rs  :: residual
  and   a   :: name
  and   x   :: name
  and   P'' :: pi
  and   α   :: freeRes

  shows "P ax>  P''  P'' τ P'  P ax>  P'"
  and   "P α  P''  P'' τ P'  P α  P'"
  and   "P τ P''  P'' ax>  P'  P ax>  P'"
  and   "P τ P''  P'' α  P'  P α  P'"
proof -
  assume PTrans: "P  ax>  P''" 
  assume P''Chain: "P'' τ P'"

  from PTrans obtain P''' P'''' where PChain: "P τ P''''"
                                  and P''''Trans: "P'''' ax>  P'''"
                                  and P'''Chain: "P''' τ P''"
    by(blast dest: transitionE)

  from P'''Chain P''Chain have "P''' τ P'" by auto
  with PChain P''''Trans show "P ax>  P'" by(rule transitionI)
next
  assume PTrans: "P α  P''" 
  assume P''Chain: "P'' τ P'"

  from PTrans obtain P''' P'''' where PChain: "P τ P''''"
                                  and P''''Trans: "P'''' α  P'''"
                                  and P'''Chain: "P''' τ P''"
    by(blast dest: transitionE)

  from P'''Chain P''Chain have "P''' τ P'" by auto
  with PChain P''''Trans show "P α  P'" by(rule transitionI)
next
  assume PChain: "P τ P''"
  assume P''Trans: "P''  ax>  P'" 

  from P''Trans obtain P''' P'''' where P''Chain: "P'' τ P''''"
                                    and P''''Trans: "P'''' ax>  P'''"
                                    and P'''Chain: "P''' τ P'"
    by(blast dest: transitionE)

  from PChain P''Chain have "P τ P''''" by auto
  thus "P ax>  P'" using P''''Trans P'''Chain by(rule transitionI)
next
  assume PChain: "P τ P''"
  assume P''Trans: "P'' α  P'" 

  from P''Trans obtain P''' P'''' where P''Chain: "P'' τ P''''"
                                    and P''''Trans: "P'''' α  P'''"
                                    and P'''Chain: "P''' τ P'"
    by(blast dest: transitionE)

  from PChain P''Chain have "P τ P''''" by auto
  thus "P α  P'" using P''''Trans P'''Chain by(rule transitionI)
qed

lemma freshBoundOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P ax>  P'"
  and     "c  P"
  and     "c  x"

  shows "c  P'"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' ax>  P''"
                                and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)

  from PChain c  P have "c  P'''" by(rule freshChain)
  with P'''Trans have "c  P''" using c  x by(rule Early_Semantics.freshTransition)
  with P''Chain show "c  P'" by(rule freshChain)
qed

lemma freshTauTransition:
  fixes P :: pi
  and   c :: name

  assumes PTrans: "P τ  P'"
  and     "c  P"

  shows "c  P'"
proof -
  from PTrans have "P τ P'" by(rule tauTransitionChain)
  thus ?thesis using c  P by(rule freshChain)
qed

lemma freshOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P a[b]  P'"
  and     "c  P"

  shows "c  P'"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' a[b]  P''"
                                and P''Chain: "P'' τ P'"
      by(blast dest: transitionE)

    from PChain c  P have "c  P'''" by(rule freshChain)
    with P'''Trans have "c  P''" by(rule Early_Semantics.freshTransition)
    with P''Chain show ?thesis by(rule freshChain)
qed

lemma eqvtI[eqvt]:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   p :: "name prm"
  and   α :: freeRes

  shows "P ax>  P'  (p  P) (p  a)(p  x)>  (p  P')"
  and   "P α  P'  (p  P) (p  α)  (p  P')"
proof -
  assume "P ax>  P'"
  then obtain P'' P''' where PChain: "P τ P'''"
                         and P'''Trans: "P''' ax>  P''"
                         and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)

  from PChain have "(p  P) τ (p  P''')" by(rule eqvtChainI)
  moreover from P'''Trans have "(p  P''')  (p  (ax>  P''))"
    by(rule TransitionsEarly.eqvt)
  hence "(p  P''')  (p  a)(p  x)>  (p  P'')"
    by(simp add: eqvts)
  moreover from P''Chain have "(p  P'') τ (p  P')" by(rule eqvtChainI)
  ultimately show "(p  P) (p  a)(p  x)>  (p  P')"
    by(rule transitionI)
next
  assume "P α  P'"
  then obtain P'' P''' where PChain: "P τ P'''"
                         and P'''Trans: "P''' α  P''"
                         and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)
  
  from PChain have "(p  P) τ (p  P''')" by(rule eqvtChainI)
  moreover from P'''Trans have "(p  P''')  (p  (α  P''))"
    by(rule TransitionsEarly.eqvt)
  hence "(p  P''')  (p  α)  (p  P'')"
    by(simp add: eqvts)
  moreover from P''Chain have "(p  P'') τ (p  P')" by(rule eqvtChainI)
  ultimately show "(p  P) (p  α)  (p  P')"
    by(rule transitionI)
qed
    
lemma freshInputTransition:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P a<b>  P'"
  and     "c  P"
  and     "c  b"

  shows "c  P'"
proof -
  from PTrans obtain P'' P''' where PChain: "P τ P'''"
                                and P'''Trans: "P''' a<b>  P''"
                                and P''Chain: "P'' τ P'"
    by(blast dest: transitionE)

  from PChain c  P have "c  P'''" by(rule freshChain)
  with P'''Trans have "c  P''" using c  b by(rule Early_Semantics.freshInputTransition)
  with P''Chain show ?thesis by(rule freshChain)
qed

lemmas freshTransition = freshBoundOutputTransition freshOutputTransition
                         freshInputTransition freshTauTransition

end

Theory Weak_Early_Semantics

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Semantics
  imports Weak_Early_Step_Semantics
begin

definition weakFreeTransition :: "pi  freeRes  pi  bool" ("_ ^_  _" [80, 80, 80] 80) 
  where "P ^α  P'  P α  P'  (α = τ  P = P')"

lemma weakTransitionI:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi

  shows "P α  P'  P ^α  P'"
  and   "P ^τ  P"
by(auto simp add: weakFreeTransition_def)

lemma transitionCases[consumes 1, case_names Step Stay]:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi

  assumes "P ^α  P'"
  and     "P α  P'  F α P'"
  and     "F (τ) P"

  shows "F α P'"
using assms
by(auto simp add: weakFreeTransition_def)

lemma singleActionChain:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi

  assumes "P α  P'"

  shows "P ^α  P'"
using assms
by(auto dest: singleActionChain intro: weakTransitionI)

lemma Tau:
  fixes P :: pi

  shows "τ.(P) ^ τ   P"
by(auto intro: Weak_Early_Step_Semantics.Tau
   simp add: weakFreeTransition_def)

lemma Input:
  fixes a :: name
  and   x :: name
  and   u :: name
  and   P :: pi

  shows "a<x>.P ^ a<u>  P[x::=u]"
by(auto intro: Weak_Early_Step_Semantics.Input
   simp add: weakFreeTransition_def)
  
lemma Output:
  fixes a :: name
  and   b :: name
  and   P :: pi

  shows "a{b}.P ^a[b]  P"
by(auto intro: Weak_Early_Step_Semantics.Output
   simp add: weakFreeTransition_def)

lemma Par1F:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   Q  :: pi

  assumes "P ^α  P'"

  shows "P  Q ^α  (P'  Q)"
using assms
by(auto intro: Weak_Early_Step_Semantics.Par1F
   simp add: weakFreeTransition_def residual.inject)

lemma Par2F:
  fixes Q :: pi
  and   α  :: freeRes
  and   Q' :: pi
  and   P  :: pi

  assumes QTrans: "Q ^α  Q'"

  shows "P  Q ^α  (P  Q')"
using assms
by(auto intro: Weak_Early_Step_Semantics.Par2F
   simp add: weakFreeTransition_def residual.inject)


lemma ResF:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   x  :: name

  assumes "P ^α  P'"
  and     "x  α"

  shows "x>P ^α  x>P'"
using assms
by(auto intro: Weak_Early_Step_Semantics.ResF
   simp add: weakFreeTransition_def residual.inject)

lemma Bang:
  fixes P  :: pi
  and   Rs :: residual

  assumes "P  !P ^α  P'"
  and     "P'  P  !P"
  
  shows "!P ^α  P'"
using assms
by(auto intro: Weak_Early_Step_Semantics.Bang
   simp add: weakFreeTransition_def residual.inject)

lemma tauTransitionChain[simp]:
  fixes P  :: pi
  and   P' :: pi

  shows "P ^τ  P' = P τ P'"
apply(auto dest: Weak_Early_Step_Semantics.tauTransitionChain
      simp add: weakFreeTransition_def)
by(erule rtrancl.cases) (auto intro: transitionI)

lemma tauStepTransitionChain[simp]:
  fixes P  :: pi
  and   P' :: pi

  assumes "P  P'"

  shows "P τ  P' = P τ P'"
using assms
apply(auto dest: Weak_Early_Step_Semantics.tauTransitionChain
      simp add: weakFreeTransition_def)
by(erule rtrancl.cases) (auto intro: transitionI)

lemma chainTransitionAppend:
  fixes P   :: pi
  and   P'  :: pi
  and   Rs  :: residual
  and   a   :: name
  and   x   :: name
  and   P'' :: pi
  and   α   :: freeRes

  shows "P τ P''  P'' ^α  P'   P ^α  P'"
  and   "P ^α  P''  P'' τ P'  P ^α  P'"
by(auto intro: chainTransitionAppend simp add: weakFreeTransition_def dest: Weak_Early_Step_Semantics.tauTransitionChain)

lemma freshTauTransition:
  fixes P :: pi
  and   c :: name

  assumes "P ^τ  P'"
  and     "c  P"

  shows "c  P'"
using assms
by(auto intro: Weak_Early_Step_Semantics.freshTauTransition
   simp add: weakFreeTransition_def residual.inject)

lemma freshOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   c  :: name

  assumes "P ^a[b]  P'"
  and     "c  P"

  shows "c  P'"
using assms
by(auto intro: Weak_Early_Step_Semantics.freshOutputTransition
   simp add: weakFreeTransition_def residual.inject)

lemma eqvtI:
  fixes P  :: pi
  and   α  :: freeRes
  and   P' :: pi
  and   p  :: "name prm"

  assumes "P ^α  P'"

  shows "(p  P) ^(p  α)  (p  P')"
using assms
by(auto intro: Weak_Early_Step_Semantics.eqvtI
   simp add: weakFreeTransition_def residual.inject)

lemma freshInputTransition:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   c  :: name

  assumes "P ^a<b>  P'"
  and     "c  P"
  and     "c  b"

  shows "c  P'"
using assms
by(auto intro: Weak_Early_Step_Semantics.freshInputTransition
   simp add: weakFreeTransition_def residual.inject)

lemmas freshTransition = freshBoundOutputTransition freshOutputTransition
                         freshInputTransition freshTauTransition

end

Theory Weak_Early_Sim

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Sim
  imports Weak_Early_Semantics Strong_Early_Sim_Pres
begin

definition weakSimulation :: "pi  (pi × pi) set  pi  bool" ("_ ↝<_> _" [80, 80, 80] 80)
  where "P ↝<Rel> Q  (a x Q'. Q ax>  Q'  x  P  (P'. P ax>  P'  (P', Q')  Rel)) 
                       (α Q'. Q α  Q'  (P'. P ^α  P'  (P', Q')  Rel))"

lemma monotonic: 
  fixes A  :: "(pi × pi) set"
  and   B  :: "(pi × pi) set"
  and   P  :: pi
  and   P' :: pi

  assumes "P ↝<A> P'"
  and     "A  B"

  shows "P ↝<B> P'"
using assms
by(simp add: weakSimulation_def) blast

lemma simCasesCont[consumes 1, case_names Bound Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   C   :: "'a::fs_name"

  assumes Eqvt:  "eqvt Rel"
  and     Bound: "a x Q'. Q  ax>  Q'; x  P; x  Q; x  a; x  C  P'. P ax>  P'  (P', Q')  Rel"
  and     Free:  "α Q'. Q  α  Q'  P'. P ^ α  P'  (P', Q')  Rel"

  shows "P ↝<Rel> Q"
proof(auto simp add: weakSimulation_def)
  fix a x Q'
  assume QTrans: "Q  ax>  Q'" and "x  P"
  obtain c::name where "c  P" and "c  Q" and "c  a" and "c  Q'" and "c  C" and "c  x"
    by(generate_fresh "name") auto

  from QTrans c  Q' have "Q  ac>  ([(x, c)]  Q')" by(simp add: alphaBoundOutput)
  then obtain P' where PTrans: "P ac>  P'" and P'RelQ': "(P', [(x, c)]  Q')  Rel"
    using c  P c  Q c  a c  C
    by(drule_tac Bound) auto

  from PTrans x  P c  x have "P ax>  ([(x, c)]  P')"
    by(force intro: weakTransitionAlpha simp add: name_swap)
  moreover from Eqvt P'RelQ' have "([(x, c)]  P', [(x, c)]  [(x, c)]  Q')  Rel"
    by(rule eqvtRelI)
  hence "([(x, c)]  P', Q')  Rel" by simp
  ultimately show "P'. P ax>  P'  (P', Q')  Rel"
    by blast
next
  fix α Q'
  assume "Q α  Q'"
  thus "P'. P ^α  P'  (P', Q')  Rel"
    by(rule Free)
qed

lemma simCases[case_names Bound Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   C   :: "'a::fs_name"

  assumes "Q' a x. Q  ax>  Q'; x  P  P'. P ax>  P'  (P', Q')  Rel"
  and     "Q' α. Q  α  Q'  P'. P ^ α  P'  (P', Q')  Rel"

  shows "P ↝<Rel> Q"
using assms
by(auto simp add: weakSimulation_def)

lemma simE:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   Q'  :: pi

  assumes "P ↝<Rel> Q"

  shows "Q ax>  Q'  x  P  P'. P ax>  P'  (P', Q')  Rel"
  and   "Q α  Q'  P'. P ^α  P'  (P', Q')  Rel"
using assms by(simp add: weakSimulation_def)+

lemma weakSimTauChain:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"
  and   Q   :: pi
  and   Q'  :: pi

  assumes QChain: "Q τ Q'"
  and     PRelQ: "(P, Q)  Rel"
  and     PSimQ: "R S. (R, S)  Rel  R ↝<Rel> S"

  shows "P'. P τ P'  (P', Q')  Rel"
proof -
  from QChain show ?thesis
  proof(induct rule: tauChainInduct)
    case id
    moreover have "P τ P" by simp
    ultimately show ?case using PSimQ PRelQ by blast
  next
    case(ih Q' Q'')
    have "P'. P τ P'  (P', Q')  Rel" by fact
    then obtain P' where PChain: "P τ P'" and P'Rel'Q': "(P', Q')  Rel" by blast
    from P'Rel'Q' have "P' ↝<Rel> Q'" by(rule PSimQ)
    moreover have Q'Trans: "Q' τ  Q''" by fact
    ultimately obtain P'' where P'Trans: "P' ^τ  P''" and P''RelQ'': "(P'', Q'')  Rel"
      by(blast dest: simE)
    from P'Trans have "P' τ P''" by simp
    with PChain have "P τ P''" by auto
    with P''RelQ'' show ?case by blast
  qed
qed

lemma simE2:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   Q'  :: pi

  assumes Sim: "R S. (R, S)  Rel  R ↝<Rel> S"
  and     Eqvt: "eqvt Rel"
  and     PRelQ: "(P, Q)  Rel"

  shows "Q ax>  Q'  x  P  P'. P ax>  P'  (P', Q')  Rel"
  and   "Q ^α  Q'  P'. P ^α  P'  (P', Q')  Rel"
proof -
  assume QTrans: "Q ax>  Q'" and "x  P"
  from QTrans obtain Q'' Q''' where QChain: "Q τ Q'''"
                                and Q'''Trans: "Q''' ax>  Q''"
                                and Q''Chain: "Q'' τ Q'"
    by(blast dest: transitionE)

  from QChain PRelQ Sim obtain P''' where PChain: "P τ P'''" and P'''RelQ''': "(P''', Q''')  Rel" 
    by(blast dest: weakSimTauChain)

  from PChain x  P have "x  P'''" by(rule freshChain)
      
  from P'''RelQ''' have "P''' ↝<Rel> Q'''" by(rule Sim)
  with Q'''Trans x  P''' obtain P'' where P'''Trans: "P''' ax>  P''"
                                         and P''RelQ'': "(P'', Q'')  Rel"
    by(blast dest: simE)

  from Q''Chain P''RelQ'' Sim obtain P' where P''Chain: "P'' τ P'" and P'RelQ': "(P', Q')  Rel"
    by(blast dest: weakSimTauChain)
  from PChain P'''Trans P''Chain  have "P ax>  P'"
    by(blast dest: Weak_Early_Step_Semantics.chainTransitionAppend)
  with P'RelQ' show "P'. P ax>  P'  (P', Q')  Rel" by blast
next
  assume "Q ^α  Q'"
  thus "P'. P ^α  P'  (P', Q')  Rel"
  proof(induct rule: transitionCases)
    case Step
    have "Q α  Q'" by fact
    then obtain Q'' Q''' where QChain: "Q τ Q''" 
                           and Q''Trans: "Q'' α  Q'''"
                           and Q'''Chain: "Q''' τ Q'"
      by(blast dest: transitionE)

    from QChain PRelQ Sim have "P''. P τ P''  (P'', Q'')  Rel"
      by(rule weakSimTauChain)
    then obtain P'' where PChain: "P τ P''" and P''RelQ'': "(P'', Q'')  Rel" by blast
    from P''RelQ'' have "P'' ↝<Rel> Q''" by(rule Sim)
    with Q''Trans obtain P''' where P''Trans: "P'' ^α  P'''"
                                and P'''RelQ''': "(P''', Q''')  Rel"
      by(blast dest: simE)
    
    have "P'. P''' τ P'  (P', Q')  Rel" using Q'''Chain P'''RelQ''' Sim
      by(rule weakSimTauChain)
    then obtain P' where P'''Chain: "P''' τ P'" and P'RelQ': "(P', Q')  Rel" by blast
    
    from PChain P''Trans P'''Chain have "P ^α  P'"
      by(blast dest: chainTransitionAppend)
    with P'RelQ' show ?case by blast
  next
    case Stay
    have "P ^τ  P" by simp
    thus ?case using PRelQ by blast
  qed
qed

lemma eqvtI:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   perm :: "name prm"

  assumes PSimQ: "P ↝<Rel> Q"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel': "eqvt Rel'"

  shows "(perm  P) ↝<Rel'> (perm  Q)"
proof(induct rule: simCases)
  case(Bound Q' a x)
  have xFreshP: "x  perm  P" by fact
  have QTrans: "(perm  Q)  ax>  Q'" by fact

  hence "(rev perm  (perm  Q))  rev perm  (ax>  Q')" by(rule eqvts)
  hence "Q  (rev perm  a)(rev perm  x)>  (rev perm  Q')" 
    by(simp add: name_rev_per)
  moreover from xFreshP have "(rev perm  x)  P" by(simp add: name_fresh_left)
  ultimately obtain P' where PTrans: "P (rev perm  a)(rev perm  x)>  P'"
                         and P'RelQ': "(P', rev perm  Q')  Rel" using PSimQ
    by(blast dest: simE)
  
  from PTrans have "(perm  P) (perm  rev perm  a)(perm  rev perm  x)>  perm  P'" 
    by(rule eqvts)
  hence "(perm  P) ax>  (perm  P')" by(simp add: name_per_rev)
  moreover from P'RelQ' RelRel' have "(P', rev perm  Q')  Rel'" by blast
  with EqvtRel' have "(perm  P', perm  (rev perm  Q'))  Rel'"
    by(rule eqvtRelI)
  hence "(perm  P', Q')  Rel'" by(simp add: name_per_rev)
  ultimately show ?case by blast
next
  case(Free Q' α)
  have QTrans: "(perm  Q)  α  Q'" by fact

  hence "(rev perm  (perm  Q))  rev perm  (α  Q')" by(rule eqvts)
  hence "Q  (rev perm  α)  (rev perm  Q')"  by(simp add: name_rev_per)
  with PSimQ obtain P' where PTrans: "P ^ (rev perm  α)  P'"
                         and PRel: "(P', (rev perm  Q'))  Rel"
    by(blast dest: simE)

  from PTrans have "(perm  P) ^ (perm  rev perm  α)  perm  P'"
    by(rule Weak_Early_Semantics.eqvtI)
  hence L1: "(perm  P) ^ α  (perm  P')" by(simp add: name_per_rev)
  from PRel EqvtRel' RelRel'  have "((perm  P'), (perm  (rev perm  Q')))  Rel'"
    by(force intro: eqvtRelI)
  hence "((perm  P'), Q')  Rel'" by(simp add: name_per_rev)
  with L1 show ?case by blast
qed

(*****************Reflexivity and transitivity*********************)

lemma reflexive:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "P ↝<Rel> P"
using assms
by(auto intro: Weak_Early_Step_Semantics.singleActionChain
   simp add: weakSimulation_def weakFreeTransition_def)

lemma transitive:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"

  assumes QSimR: "Q ↝<Rel'> R"
  and     Eqvt: "eqvt Rel"
  and     Eqvt'': "eqvt Rel''"
  and     Trans: "Rel O Rel'  Rel''"
  and     Sim: "S T. (S, T)  Rel  S ↝<Rel> T"
  and     PRelQ: "(P, Q)  Rel"

  shows "P ↝<Rel''> R"
proof -
  from Eqvt'' show ?thesis
  proof(induct rule: simCasesCont[where C=Q])
    case(Bound a x R')
    have RTrans: "R ax>  R'" by fact
    from x  Q QSimR RTrans obtain Q' where QTrans: "Q ax>  Q'"
                                          and Q'Rel'R': "(Q', R')  Rel'"
      by(blast dest: simE)

    from Sim Eqvt PRelQ QTrans x  P 
    obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel"
      by(drule_tac simE2) auto
(*      by(blast dest: simE2)*)
    moreover from P'RelQ' Q'Rel'R' Trans have "(P', R')  Rel''" by blast
    ultimately show ?case by blast
  next
    case(Free α R')
    have RTrans: "R  α  R'" by fact
    with QSimR obtain Q' where QTrans: "Q ^ α  Q'" and Q'RelR': "(Q', R')  Rel'"
      by(blast dest: simE)
    from Sim Eqvt PRelQ QTrans have "P'. P ^ α  P'  (P', Q')  Rel"
      by(blast intro: simE2)
    then obtain P' where PTrans: "P ^ α  P'" and P'RelQ': "(P', Q')  Rel" by blast
    from P'RelQ' Q'RelR' Trans have "(P', R')  Rel''" by blast
    with PTrans show ?case by blast
  qed
qed

lemma strongAppend:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"

  assumes PSimQ: "P ↝<Rel> Q"
  and     QSimR: "Q ↝[Rel'] R"
  and     Eqvt'': "eqvt Rel''"
  and     Trans: "Rel O Rel'  Rel''"

  shows "P ↝<Rel''> R"
proof -
  from Eqvt'' show ?thesis
  proof(induct rule: simCasesCont[where C=Q])
    case(Bound a x R')
    have RTrans: "R ax>  R'" by fact
    from QSimR RTrans x  Q obtain Q' where QTrans: "Q ax>  Q'"
                                          and Q'Rel'R': "(Q', R')  Rel'"
      by(blast dest: Strong_Early_Sim.elim)

    with PSimQ QTrans x  P obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel" 
      by(blast dest: simE)
    moreover from P'RelQ' Q'Rel'R' Trans have "(P', R')  Rel''" by blast
    ultimately show ?case by blast
  next
    case(Free α R')
    have RTrans: "R  α  R'" by fact
    with QSimR obtain Q' where QTrans: "Q α  Q'" and Q'RelR': "(Q', R')  Rel'"
      by(blast dest: Strong_Early_Sim.elim)
    from PSimQ QTrans obtain P' where PTrans: "P ^ α  P'" and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
    from P'RelQ' Q'RelR' Trans have "(P', R')  Rel''" by blast
    with PTrans show ?case by blast
  qed
qed

lemma strongSimWeakSim:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"

  shows "P ↝<Rel> Q"
proof(induct rule: simCases)
  case(Bound Q' a x)
  have "Q ax>  Q'" by fact
  with PSimQ x  P obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel"
    by(blast dest: Strong_Early_Sim.elim)
  from PTrans have "P ax>   P'"
    by(force intro: Weak_Early_Step_Semantics.singleActionChain simp add: weakFreeTransition_def)
  with P'RelQ' show ?case by blast
next
  case(Free Q' α)
  have "Q α  Q'" by fact
  with PSimQ obtain P' where PTrans: "P α  P'" and P'RelQ': "(P', Q')  Rel"
    by(blast dest: Strong_Early_Sim.elim)
  from PTrans have "P ^α  P'" by(rule Weak_Early_Semantics.singleActionChain)
  with P'RelQ' show ?case by blast
qed

end

Theory Weak_Early_Bisim

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Bisim
  imports Weak_Early_Sim Strong_Early_Bisim
begin

lemma monoAux: "A  B  P ↝<A> Q  P ↝<B> Q"
by(auto intro: Weak_Early_Sim.monotonic)

coinductive_set weakBisim :: "(pi × pi) set"
where
  step: "P ↝<weakBisim> Q; (Q, P)  weakBisim  (P, Q)  weakBisim"
monos monoAux

abbreviation weakEarlyBisimJudge (infixr "" 65) where "P  Q  (P, Q)  weakBisim"

lemma weakBisimCoinductAux[case_names weakBisim, case_conclusion weakBisim step, consumes 1]:
  assumes p: "(P, Q)  X"
  and step:  "P Q. (P, Q)  X  P ↝<(X  weakBisim)> Q  (Q, P)  X  weakBisim"

  shows "P  Q"
proof -
  have aux: "X  weakBisim = {(P, Q). (P, Q)  X  P  Q}" by blast

  from p show ?thesis
    by(coinduct, force dest: step simp add: aux)
qed

lemma weakBisimWeakCoinductAux[case_names weakBisim, case_conclusion weakBisim step, consumes 1]:
  assumes p: "(P, Q)  X"
  and step:  "P Q. (P, Q)  X  P ↝<X> Q  (Q, P)  X"

  shows "P  Q"
using p
proof(coinduct rule: weakBisimCoinductAux)
  case (weakBisim P)
  from step[OF this] show ?case using Weak_Early_Sim.monotonic by blast
qed

lemma weakBisimCoinduct[consumes 1, case_names cSim cSym]:
  fixes P :: pi
  and   Q :: pi
  and   X :: "(pi × pi) set"

  assumes "(P, Q)  X"
  and     "R S. (R, S)  X  R ↝<(X  weakBisim)> S"
  and     "R S. (R, S)  X  (S, R)  X"

  shows "P  Q"
using assms
by(coinduct rule: weakBisimCoinductAux) auto

lemma weakBisimWeakCoinduct[consumes 1, case_names cSim cSym]:
  fixes P :: pi
  and   Q :: pi
  and   X :: "(pi × pi) set"

  assumes "(P, Q)  X"
  and     "P Q. (P, Q)  X  P ↝<X> Q"
  and     "P Q. (P, Q)  X  (Q, P)  X"

  shows "P  Q"
using assms
by(coinduct rule: weakBisimWeakCoinductAux) auto

lemma weakBisimE:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"
  
  shows "P ↝<weakBisim> Q"
  and   "Q  P"
using assms
by(auto dest: weakBisim.cases)

lemma weakBisimI:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P ↝<weakBisim> Q"
  and     "Q  P"

  shows "P  Q"
using assms
by(auto intro: weakBisim.intros)

lemma eqvt[simp]:
  shows "eqvt weakBisim"
proof(auto simp add: eqvt_def)
  let ?X = "{x. P Q (perm::name prm). P  Q  x = (perm  P, perm  Q)}"
  fix P Q
  fix perm::"name prm"
  assume PBiSimQ: "P  Q"

  hence "(perm  P, perm  Q)  ?X" by blast
  moreover have "P Q perm::name prm. P ↝<weakBisim> Q  (perm  P) ↝<?X> (perm  Q)"
  proof -
    fix P Q
    fix perm::"name prm"
    assume "P ↝<weakBisim> Q"

    moreover have "weakBisim  ?X"
    proof(auto)
      fix P Q
      assume "P  Q"
      moreover have "P = ([]::name prm)  P" and "Q = ([]::name prm)  Q" by auto
      ultimately show "P' Q'. P'  Q'  ((perm::name prm). P = perm  P'  Q = perm  Q')"
        by blast
    qed

    moreover have "eqvt ?X"
    proof(auto simp add: eqvt_def)
      fix P Q
      fix perm1::"name prm"
      fix perm2::"name prm"

      assume "P  Q"
      moreover have "perm1  perm2  P = (perm1 @ perm2)  P" by(simp add: pt2[OF pt_name_inst])
      moreover have "perm1  perm2  Q = (perm1 @ perm2)  Q" by(simp add: pt2[OF pt_name_inst])

      ultimately show "P' Q'. P'  Q'  ((perm::name prm). perm1  perm2  P = perm  P' 
                                                              perm1  perm2  Q = perm  Q')"
        by blast
    qed

    ultimately show "(perm  P) ↝<?X> (perm  Q)"
      by(rule Weak_Early_Sim.eqvtI)
    qed

    ultimately show "(perm  P)  (perm  Q)" by(coinduct rule: weakBisimWeakCoinductAux, blast dest: weakBisimE)
qed

lemma eqvtI[eqvt]:
  fixes P :: pi
  and   Q :: pi
  and   perm :: "name prm"

  assumes "P  Q"

  shows "(perm  P)  (perm  Q)"
using assms
by(rule eqvtRelI[OF eqvt])

lemma strongBisimWeakBisim:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"

  shows "P  Q"
proof -
  from P  Q show ?thesis
  proof(coinduct rule: weakBisimWeakCoinduct)
    case(cSim P Q)
    from P  Q have "P ↝[bisim] Q" by(rule bisimE)
    thus "P ↝<bisim> Q" by(rule strongSimWeakSim)
  next
    case(cSym P Q)
    thus ?case by(rule bisimE)
  qed
qed

lemma reflexive:
  fixes P :: pi

  shows "P  P"
proof -
  have "(P, P)  Id" by simp
  thus ?thesis
    by(coinduct rule: weakBisimCoinduct) (auto intro: Weak_Early_Sim.reflexive)
qed

lemma symetric:
  fixes P :: pi
  and   Q :: pi
   
  assumes "P  Q"

  shows "Q  P"
using assms
by(auto dest: weakBisimE)

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P  Q"
  and     "Q  R"

  shows "P  R"
proof -
  let ?X = "weakBisim O weakBisim"
  from assms have "(P, R)  ?X" by blast
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim P R)
    from (P, R)  ?X obtain Q where "P  Q" and "Q  R" by auto
    from Q  R have "Q ↝<weakBisim> R" by(rule weakBisimE)
    moreover have "eqvt ?X" by auto
    moreover have "?X  ?X" by simp
    ultimately show "P ↝<(?X  weakBisim)> R" using weakBisimE(1) P  Q
      by(rule_tac Weak_Early_Sim.transitive) auto
  next
    case(cSym P R)
    thus ?case by(auto dest: symetric)
  qed
qed

lemma weakBisimWeakUpto[case_names cSim cSym, consumes 1]:
  assumes p: "(P, Q)  X"
  and Eqvt: "eqvt X"
  and rSim: "P Q. (P, Q)  X  P ↝<(weakBisim O X O bisim)> Q"
  and rSym: " P Q. (P, Q)  X  (Q, P)  X"

  shows "P  Q"
proof -
  let ?X = "weakBisim O X O weakBisim"
  let ?Y = "weakBisim O X O bisim"
  from  Eqvt eqvt have "eqvt ?X" by blast
  from Strong_Early_Bisim.eqvt Eqvt eqvt have "eqvt ?Y" by blast

  from (P, Q)  X have "(P, Q)  ?X" by(blast intro: Strong_Early_Bisim.reflexive reflexive)
  thus ?thesis
  proof(coinduct rule: weakBisimWeakCoinduct)
    case(cSim P Q)
    {
      fix P P' Q' Q
      assume "P  P'" and "(P', Q')  X" and "Q'  Q"
      from Q'  Q have "Q' ↝<weakBisim> Q" by(rule weakBisimE)
      moreover note ‹eqvt ?Y ‹eqvt ?X
      moreover have "?Y O weakBisim  ?X" by(blast dest: strongBisimWeakBisim transitive)
      moreover {
        fix P Q
        assume "(P, Q)  ?Y"
        then obtain P' Q' where "P  P'" and "(P', Q')  X" and "Q'  Q" by auto
        from (P', Q')  X have "P' ↝<?Y> Q'" by(rule rSim)
        moreover from Q'  Q have "Q' ↝[bisim] Q" by(rule bisimE)
        moreover note ‹eqvt ?Y
        moreover have "?Y O bisim  ?Y" by(auto dest: Strong_Early_Bisim.transitive)
        ultimately have "P' ↝<?Y> Q" by(rule strongAppend)
        moreover note P  P'
        moreover have "weakBisim O ?Y  ?Y" by(blast dest: transitive)
        ultimately have "P ↝<?Y> Q" using weakBisimE(1) eqvt ‹eqvt ?Y
          by(rule_tac Weak_Early_Sim.transitive)
      }
      moreover from (P', Q')  X have "(P', Q')  ?Y" by(blast intro: reflexive Strong_Early_Bisim.reflexive)
      ultimately have "P' ↝<?X> Q" by(rule Weak_Early_Sim.transitive)
      moreover note P  P'
      moreover have "weakBisim O ?X  ?X" by(blast dest: transitive)
      ultimately have "P ↝<?X> Q" using weakBisimE(1) eqvt ‹eqvt ?X
        by(rule_tac Weak_Early_Sim.transitive)
    }
    with (P, Q)  ?X show ?case by auto
  next
    case(cSym P Q)
    thus ?case 
      apply auto
      by(blast dest: bisimE rSym weakBisimE)
  qed
qed

lemma weakBisimUpto[case_names cSim cSym, consumes 1]:
  assumes p: "(P, Q)  X"
  and Eqvt: "eqvt X"
  and rSim: "R S. (R, S)  X  R ↝<(weakBisim O (X  weakBisim) O bisim)> S"
  and rSym: "R S. (R, S)  X  (S, R)  X"

  shows "P  Q"
proof -
  from p  have "(P, Q)  X  weakBisim" by simp
  thus ?thesis using Eqvt
    apply(coinduct rule: weakBisimWeakUpto)
    apply(auto dest: rSim rSym weakBisimE)
    apply(rule Weak_Early_Sim.monotonic)
    apply(blast dest: weakBisimE)
    apply(auto simp add: relcomp_unfold)
    by(metis reflexive Strong_Early_Bisim.reflexive transitive)
qed


lemma transitive_coinduct_weak[case_names cSim cSym, consumes 2]:
  assumes p: "(P, Q)  X"
  and Eqvt: "eqvt X"
  and rSim: "P Q. (P, Q)  X  P ↝<(bisim O X O bisim)> Q"
  and rSym: " P Q. (P, Q)  X  (Q, P)  bisim O X O bisim"

  shows "P  Q"
proof -
  let ?X = "bisim O X O bisim"
  from (P, Q)  X have "(P, Q)  ?X" by(blast intro: Strong_Early_Bisim.reflexive)
  thus ?thesis
  proof(coinduct rule: weakBisimWeakCoinduct)
    case(cSim P Q)
    {
      fix P P' Q' Q
      assume PBisimP': "P  P'"
      assume P'SimQ': "P' ↝<?X> Q'"
      assume Q'SimQ: "Q' ↝[bisim] Q"
      
      have "P ↝<?X> Q"
      proof -
        have "P' ↝<?X> Q"
        proof -
          have "?X O bisim  ?X" by(blast intro: Strong_Early_Bisim.transitive)
          moreover from Strong_Early_Bisim.eqvt Eqvt have "eqvt ?X" by blast
          ultimately show ?thesis using P'SimQ' Q'SimQ 
            by(rule_tac strongAppend)
        qed
        moreover have "eqvt bisim" by(rule Strong_Early_Bisim.eqvt)
        moreover from Strong_Early_Bisim.eqvt Eqvt have "eqvt ?X" by blast
        moreover have "bisim O ?X  ?X" by(blast intro: Strong_Early_Bisim.transitive)
        moreover have "P Q. P  Q  P ↝<bisim> Q" by(blast dest: Strong_Early_Bisim.bisimE strongSimWeakSim)
        ultimately show ?thesis using PBisimP' by(rule Weak_Early_Sim.transitive)
      qed
    }
    thus ?case using (P, Q)  ?X rSim by (blast dest: Strong_Early_Bisim.bisimE)
  next
    case(cSym P Q)
    {
      fix P P' Q' Q
      assume "P  P'" and "(P', Q')  X" and "Q'  Q"
      from (P', Q')  X have "(Q', P')  ?X" by(rule rSym)
      with P  P' Q'  Q have "(Q, P)  ?X" 
        apply auto
        apply(drule_tac Strong_Early_Bisim.bisimE(2))
        apply(drule Strong_Early_Bisim.transitive[where Q=P'])
        apply assumption
        apply(drule_tac Strong_Early_Bisim.bisimE(2))
        apply(drule Strong_Early_Bisim.transitive[where Q=Q'])
        apply assumption
        by auto
    }
    thus ?case using (P, Q)  ?X by auto
  qed
qed

end

Theory Weak_Early_Step_Sim

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Step_Sim
  imports Weak_Early_Sim Strong_Early_Sim
begin

definition weakStepSimulation :: "pi  (pi × pi) set  pi  bool" ("_ ↝«_» _" [80, 80, 80] 80) where
  "P ↝«Rel» Q  (Q' a x. Q ax>  Q'  x  P  (P' . P ax>  P'  (P', Q')  Rel)) 
                         (Q' α. Q α  Q'  (P'. P α  P'  (P', Q')  Rel))"

lemma monotonic: 
  fixes A  :: "(pi × pi) set"
  and   B  :: "(pi × pi) set"
  and   P  :: pi
  and   P' :: pi

  assumes "P ↝«A» P'"
  and     "A  B"

  shows "P ↝«B» P'"
using assms
by(simp add: weakStepSimulation_def) blast

lemma simCasesCont[consumes 1, case_names Bound Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   C   :: "'a::fs_name"

  assumes Eqvt:  "eqvt Rel"
  and     Bound: "a x Q'. x  C; Q  ax>  Q'  P'. P  ax>  P'  (P', Q')  Rel"
  and     Free:  "α Q'. Q  α  Q'  P'. P  α  P'  (P', Q')  Rel"

  shows "P ↝«Rel» Q"
proof -
  from Free show ?thesis
  proof(auto simp add: weakStepSimulation_def)
    fix Q' a x
    assume xFreshP: "(x::name)  P"
    assume Trans: "Q  ax>  Q'"
    have "c::name. c  (P, Q', x, C)" by(blast intro: name_exists_fresh)
    then obtain c::name where cFreshP: "c  P" and cFreshQ': "c  Q'" and cFreshC: "c  C"
                          and cineqx: "c  x"
      by(force simp add: fresh_prod)

    from Trans cFreshQ' have "Q  ac>  ([(x, c)]  Q')" by(simp add: alphaBoundOutput)
    with cFreshC have "P'. P  ac>  P'  (P', [(x, c)]  Q')  Rel"
      by(rule Bound)
    then obtain P' where PTrans: "P  ac>  P'" and P'RelQ': "(P', [(x, c)]  Q')  Rel"
      by blast

    from PTrans x  P c  x have "P ax>  ([(x, c)]  P')" 
      by(simp add: weakTransitionAlpha name_swap)
    moreover from Eqvt P'RelQ' have "([(x, c)]  P', [(x, c)]  [(x, c)]  Q')  Rel"
      by(rule eqvtRelI)
    with c  x have "([(x, c)]  P', Q')  Rel"
      by simp
    ultimately show "P'. P ax>  P'  (P', Q')  Rel" by blast
  qed
qed

lemma simCases[consumes 0, case_names Bound Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   C   :: "'a::fs_name"

  assumes "a x Q'. Q  ax>  Q'; x  P  P'. P  ax>  P'  (P', Q')  Rel"
  and     "α Q'. Q  α  Q'  P'. P  α  P'  (P', Q')  Rel"

  shows "P ↝«Rel» Q"
using assms
by(auto simp add: weakStepSimulation_def)

lemma simE:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   Q'  :: pi

  assumes "P ↝«Rel» Q"

  shows "Q ax>  Q'  x  P  P'. P ax>  P'  (P', Q')  Rel"
  and   "Q α  Q'  P'. P α  P'  (P', Q')  Rel"
using assms by(simp add: weakStepSimulation_def)+

lemma simE2:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   Q'  :: pi

  assumes PSimQ: "P ↝«Rel» Q"
  and     Sim: "R S. (R, S)  Rel  R ↝<Rel> S"
  and     Eqvt: "eqvt Rel"
  and     PRelQ: "(P, Q)  Rel"

  shows "Q ax>  Q'  x  P  P'. P ax>  P'  (P', Q')  Rel"
  and   "Q α  Q'  P'. P α  P'  (P', Q')  Rel"
proof -
  assume QTrans: "Q ax>  Q'"
  assume "x  P"
    
  from QTrans obtain Q'' Q''' where QChain: "Q τ Q''"
                                        and Q''Trans: "Q'' ax>  Q'''"
                                        and Q'''Chain: "Q''' τ Q'"
    by(blast dest: transitionE)

  from QChain PRelQ Sim have "P''. P τ P''  (P'', Q'')  Rel"
    by(rule weakSimTauChain)
  then obtain P'' where PChain: "P τ P''" and P''RelQ'': "(P'', Q'')  Rel" by blast
  from PChain x  P have xFreshP'': "x  P''" by(rule freshChain)
  
  from P''RelQ'' have "P'' ↝<Rel> Q''" by(rule Sim)
  with Q''Trans xFreshP'' obtain P''' where P''Trans: "P'' ax>  P'''"
                                        and P'''RelQ''': "(P''', Q''')  Rel"
    by(blast dest: Weak_Early_Sim.simE)

  have "P'. P''' τ P'  (P', Q')  Rel" using Q'''Chain P'''RelQ''' Sim
    by(rule weakSimTauChain)
  then obtain P' where P'''Chain: "P''' τ P'" and P'RelQ': "(P', Q')  Rel" by blast
    
  from PChain P''Trans P'''Chain have "P ax>  P'"
    by(blast dest: Weak_Early_Step_Semantics.chainTransitionAppend)
  with P'RelQ' show "P'. P  ax>  P'  (P', Q')  Rel"
    by blast
next
  assume "Q α  Q'"

  then obtain Q'' Q''' where QChain: "Q τ Q''" 
                         and Q''Trans: "Q'' α  Q'''"
                         and Q'''Chain: "Q''' τ Q'"
    by(blast dest: transitionE)
  from QChain Q''Trans Q'''Chain show "P'. P α  P'  (P', Q')  Rel"
  proof(induct arbitrary: α Q''' Q' rule: tauChainInduct)
    case id
    from PSimQ Q α  Q''' have "P'. P α  P'  (P', Q''')  Rel"
      by(blast dest: simE)
    then obtain P''' where PTrans: "P α  P'''" and P'RelQ''': "(P''', Q''')  Rel"
      by blast
    
    have "P'. P''' τ P'  (P', Q')  Rel" using Q''' τ Q' P'RelQ''' Sim
      by(rule Weak_Early_Sim.weakSimTauChain)
    then obtain P' where P'''Chain: "P''' τ P'" and P'RelQ': "(P', Q')  Rel" by blast
    
    from P'''Chain PTrans have "P α  P'"
      by(blast dest: Weak_Early_Step_Semantics.chainTransitionAppend)
    
    with P'RelQ' show ?case by blast
  next
    case(ih Q'''' Q'' α Q''' Q')
    have "Q'' τ Q''" by simp
    with Q'''' τ  Q'' obtain P'' where PChain: "P τ   P''" and P''RelQ'': "(P'', Q'')  Rel"
      by(drule_tac ih) auto

    from P''RelQ'' have "P'' ↝<Rel> Q''" by(rule Sim)
    hence "P'''. P'' ^α  P'''  (P''', Q''')  Rel" using Q'' α  Q'''
      by(rule Weak_Early_Sim.simE)
    then obtain P''' where P''Trans: "P'' ^α  P'''"
                       and P'''RelQ''': "(P''', Q''')  Rel"
      by blast
    from Q''' τ Q' P'''RelQ''' Sim have "P'. P''' τ P'  (P', Q')  Rel"
      by(rule Weak_Early_Sim.weakSimTauChain)
    then obtain P' where P'''Chain: "P''' τ P'"
                     and P'RelQ': "(P', Q')  Rel"
      by blast
    from PChain P''Trans have "P α  P'''"
      apply(auto simp add: freeTransition_def weakFreeTransition_def)
      apply(drule tauActTauChain, auto)
      by(rule_tac x=P'''aa in exI) auto
    hence "P α  P'" using P'''Chain
      by(rule Weak_Early_Step_Semantics.chainTransitionAppend)
    with P'RelQ' show ?case by blast
  qed
qed

lemma eqvtI:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   perm :: "name prm"

  assumes PSimQ: "P ↝«Rel» Q"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel': "eqvt Rel'"

  shows "(perm  P) ↝«Rel'» (perm  Q)"
proof(induct rule: simCases)
  case(Bound a x Q')
  have xFreshP: "x  perm  P" by fact
  have QTrans: "(perm  Q)  ax>  Q'" by fact

  hence "(rev perm  (perm  Q))  rev perm  (ax>  Q')" by(rule eqvt)
  hence "Q  (rev perm  a)(rev perm  x)>  (rev perm  Q')" 
    by(simp add: name_rev_per)
  moreover from xFreshP have "(rev perm  x)  P" by(simp add: name_fresh_left)
  ultimately obtain P' where PTrans: "P  (rev perm  a)(rev perm  x)>  P'"
                         and P'RelQ': "(P', rev perm  Q')  Rel" using PSimQ
    by(blast dest: simE)
  
  from PTrans have "(perm  P) (perm  rev perm  a)(perm  rev perm  x)>  perm  P'" 
    by(rule Weak_Early_Step_Semantics.eqvtI)
  hence L1: "(perm  P)  ax>  (perm  P')" by(simp add: name_per_rev)
  from P'RelQ' RelRel' have "(P', rev perm  Q')  Rel'" by blast
  with EqvtRel' have "(perm  P', perm  (rev perm  Q'))  Rel'"
    by(rule eqvtRelI)
  hence "(perm  P', Q')  Rel'" by(simp add: name_per_rev)
  with L1 show ?case by blast
next
  case(Free α Q')
  have QTrans: "(perm  Q)  α  Q'" by fact

  hence "(rev perm  (perm  Q))  rev perm  (α  Q')" by(rule eqvts)
  hence "Q  (rev perm  α)  (rev perm  Q')"  by(simp add: name_rev_per)
  with PSimQ obtain P' where PTrans: "P  (rev perm  α)  P'"
                         and PRel: "(P', (rev perm  Q'))  Rel"
    by(blast dest: simE)

  from PTrans have "(perm  P) (perm  rev perm  α)  perm  P'"
    by(rule Weak_Early_Step_Semantics.eqvtI)
  hence L1: "(perm  P)  α  (perm  P')" by(simp add: name_per_rev)
  from PRel EqvtRel' RelRel'  have "((perm  P'), (perm  (rev perm  Q')))  Rel'"
    by(force intro: eqvtRelI)
  hence "((perm  P'), Q')  Rel'" by(simp add: name_per_rev)
  with L1 show ?case by blast
qed

(*****************Reflexivity and transitivity*********************)

lemma reflexive:
  fixes P   :: pi
  and   Rel :: "(pi × pi) set"

  assumes "Id  Rel"

  shows "P ↝«Rel» P"
using assms
by(auto intro: Weak_Early_Step_Semantics.singleActionChain
   simp add: weakStepSimulation_def weakFreeTransition_def)

lemma transitive:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"

  assumes PSimQ: "P ↝«Rel» Q"
  and     QSimR: "Q ↝«Rel'» R"
  and     Eqvt: "eqvt Rel"
  and     Eqvt'': "eqvt Rel''"
  and     Trans: "Rel O Rel'  Rel''"
  and     Sim: "S T. (S, T)  Rel  S ↝<Rel> T"
  and     PRelQ: "(P, Q)  Rel"

  shows "P ↝«Rel''» R"
proof -
  from Eqvt'' show ?thesis
  proof(induct rule: simCasesCont[of _ "(P, Q)"])
    case(Bound a x R')
    have "x  (P, Q)" by fact
    hence xFreshP: "x  P" and xFreshQ: "x  Q" by(simp add: fresh_prod)+
    have RTrans: "R ax>  R'" by fact
    from xFreshQ QSimR RTrans obtain Q' where QTrans: "Q  ax>  Q'"
                                          and Q'Rel'R': "(Q', R')  Rel'"
      by(blast dest: simE)

    with PSimQ Sim Eqvt PRelQ QTrans xFreshP have "P'. P  ax>  P'  (P', Q')  Rel"
      by(blast intro: simE2)
    then obtain P' where PTrans: "P  ax>  P'" and P'RelQ': "(P', Q')  Rel" by blast
    moreover from P'RelQ' Q'Rel'R' Trans have "(P', R')  Rel''" by blast
    ultimately show ?case by blast
  next
    case(Free α R')
    have RTrans: "R  α  R'" by fact
    with QSimR obtain Q' where QTrans: "Q  α  Q'" and Q'RelR': "(Q', R')  Rel'"
      by(blast dest: simE)
    from PSimQ Sim Eqvt PRelQ QTrans have "P'. P  α  P'  (P', Q')  Rel"
      by(blast intro: simE2)
    then obtain P' where PTrans: "P  α  P'" and P'RelQ': "(P', Q')  Rel" by blast
    from P'RelQ' Q'RelR' Trans have "(P', R')  Rel''" by blast
    with PTrans show ?case by blast
  qed
qed

lemma strongSimWeakSim:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"

  assumes PSimQ: "P ↝[Rel] Q"

  shows "P ↝«Rel» Q"
proof(induct rule: simCases)
  case(Bound a x Q')
  have "Q ax>  Q'" and "x  P" by fact+
  with PSimQ obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel"
    by(blast dest: Strong_Early_Sim.elim)
  from PTrans have "P ax>   P'"
    by(force intro: Weak_Early_Step_Semantics.singleActionChain simp add: weakFreeTransition_def)
  with P'RelQ' show ?case by blast
next
  case(Free α Q')
  have "Q α  Q'" by fact
  with PSimQ obtain P' where PTrans: "P α  P'" and P'RelQ': "(P', Q')  Rel"
    by(blast dest: Strong_Early_Sim.elim)
  from PTrans have "P α  P'" by(rule Weak_Early_Step_Semantics.singleActionChain)
  with P'RelQ' show ?case by blast
qed

lemma weakSimWeakEqSim:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"

  assumes "P ↝«Rel» Q"

  shows "P ↝<Rel> Q"
using assms
by(force simp add: weakStepSimulation_def Weak_Early_Sim.weakSimulation_def weakFreeTransition_def)

end


Theory Weak_Early_Cong

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Cong
  imports Weak_Early_Bisim Weak_Early_Step_Sim Strong_Early_Bisim
begin

definition weakCongruence :: "pi  pi  bool" (infixr "" 65)
where "P  Q  P ↝«weakBisim» Q  Q ↝«weakBisim» P"

lemma weakCongISym[consumes 1, case_names cSym cSim]:
  fixes P :: pi
  and   Q :: pi

  assumes "Prop P Q"
  and     "R S. Prop R S  Prop S R"
  and     "R S. Prop R S  (F R) ↝«weakBisim» (F S)"

  shows "F P  F Q"
using assms
by(auto simp add: weakCongruence_def)

lemma weakCongISym2[consumes 1, case_names cSim]:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"
  and     "R S. R  S  (F R) ↝«weakBisim» (F S)"

  shows "F P  F Q"
using assms
by(auto simp add: weakCongruence_def)

lemma weakCongEE:
  fixes P :: pi
  and   Q :: pi
  and   s :: "(name × name) list"

  assumes "P  Q"

  shows "P ↝«weakBisim» Q"
  and   "Q ↝«weakBisim» P"
using assms
by(auto simp add: weakCongruence_def)

lemma weakCongI:
  fixes P :: pi
  and   Q :: pi

  assumes "P ↝«weakBisim» Q"
  and     "Q ↝«weakBisim» P"

  shows "P  Q"
using assms
by(auto simp add: weakCongruence_def)

lemma eqvtI[eqvt]:
  fixes P :: pi
  and   Q :: pi
  and   p :: "name prm"

  assumes "P  Q"

  shows "(p  P)  (p  Q)"
using assms
by(auto simp add: weakCongruence_def intro: eqvtI)

lemma strongBisimWeakCong:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"

  shows "P  Q"
proof -
  have "P Q. P ↝[bisim] Q  P ↝«weakBisim» Q"
  proof -
    fix P Q
    assume "P ↝[bisim] Q"
    hence "P ↝«bisim» Q" by(rule Weak_Early_Step_Sim.strongSimWeakSim)
    moreover have "bisim  weakBisim"
      by(auto intro: strongBisimWeakBisim)
    ultimately show "P ↝«weakBisim» Q" by(rule Weak_Early_Step_Sim.monotonic)
  qed
  with assms show ?thesis
    by(blast intro: weakCongI dest: Strong_Early_Bisim.bisimE)
qed

lemma congruenceWeakBisim:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"

  shows "P  Q"
using assms
proof -
  let ?X = "{(P, Q) | P Q. P  Q}"
  from assms have "(P, Q)  ?X" by simp
  thus ?thesis 
  proof(induct rule: weakBisimCoinduct)
    case(cSim P Q) 
    {
      fix P Q
      assume "P  Q"
      hence "P ↝«weakBisim» Q" by(simp add: weakCongruence_def)
      hence "P ↝«(?X  weakBisim)» Q" by(rule_tac Weak_Early_Step_Sim.monotonic) auto
      hence "P ↝<(?X  weakBisim)> Q" by(rule weakSimWeakEqSim)
    }
    with (P, Q)  ?X show ?case by auto
  next
    case(cSym P Q)
    thus ?case by(auto simp add: weakCongruence_def)
  qed
qed

lemma reflexive:
  fixes P :: pi
  
  shows "P  P"
proof -
  from Weak_Early_Bisim.reflexive have "P. P ↝«weakBisim» P"
    by(blast intro: Weak_Early_Step_Sim.reflexive)
  thus ?thesis
    by(force simp add: substClosed_def weakCongruence_def)
qed

lemma symetric:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P  Q"
  
  shows "Q  P"
using assms
by(force simp add: substClosed_def weakCongruence_def)

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  assumes "P  Q"
  and     "Q  R"
  
  shows "P  R"
proof -
  have Goal: "P Q R. P ↝«weakBisim» Q; Q ↝«weakBisim» R; P  Q  P ↝«weakBisim» R"
    using Weak_Early_Bisim.eqvt Weak_Early_Bisim.weakBisimE Weak_Early_Bisim.transitive
    by(blast intro: Weak_Early_Step_Sim.transitive)
  from assms show ?thesis
    apply(simp add: weakCongruence_def) using assms
    by(blast intro: Goal dest: congruenceWeakBisim symetric)
qed

end

Theory Weak_Early_Bisim_Subst

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Bisim_Subst
  imports Weak_Early_Bisim Strong_Early_Bisim_Subst
begin

consts weakBisimSubst :: "(pi × pi) set"
abbreviation weakEarlyBisimSubstJudge (infixr "s" 65) where "P s Q  (P, Q)  (substClosed weakBisim)"

lemma congBisim:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"

  shows "P  Q"
using assms substClosedSubset 
by blast

lemma strongBisimWeakBisim:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "P s Q"
using assms
by(auto simp add: substClosed_def intro: strongBisimWeakBisim)

lemma eqvt:
  shows "eqvt (substClosed weakBisim)"
by(rule eqvtSubstClosed[OF Weak_Early_Bisim.eqvt])

lemma eqvtI[eqvt]:
  fixes P :: pi
  and   Q :: pi
  and   perm :: "name prm"

  assumes "P s Q"

  shows "(perm  P) s (perm  Q)"
using assms
by(rule eqvtRelI[OF eqvt])

lemma reflexive:
  fixes P :: pi
  
  shows "P s P"
by(force simp add: substClosed_def intro: Weak_Early_Bisim.reflexive)

lemma symetric:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"
  
  shows "Q s P"
using assms
by(force simp add: substClosed_def intro: Weak_Early_Bisim.symetric)

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  assumes "P s Q"
  and     "Q s R"
  
  shows "P s R"
using assms
by(force simp add: substClosed_def intro: Weak_Early_Bisim.transitive)

lemma partUnfold:
  fixes P :: pi
  and   Q :: pi
  and   s :: "(name × name) list"

  assumes "P s Q"

  shows "P[<s>] s Q[<s>]"
using assms
proof(auto simp add: substClosed_def)
  fix s'
  assume "s. P[<s>]  Q[<s>]"
  hence "P[<(s@s')>]  Q[<(s@s')>]" by blast
  moreover have "P[<(s@s')>] = (P[<s>])[<s'>]"
    by(induct s', auto)
  moreover have "Q[<(s@s')>] = (Q[<s>])[<s'>]"
    by(induct s', auto)
    
  ultimately show "(P[<s>])[<s'>]  (Q[<s>])[<s'>]"
    by simp
qed
  
end

Theory Weak_Early_Cong_Subst

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Cong_Subst
  imports Weak_Early_Cong Weak_Early_Bisim_Subst Strong_Early_Bisim_Subst
begin

consts congruenceSubst :: "(pi × pi) set"

definition weakCongruenceSubst (infixr "s" 65) where "P s Q  σ. P[<σ>]  Q[<σ>]"

lemma unfoldE:
  fixes P :: pi
  and   Q :: pi
  and   s :: "(name × name) list"

  assumes "P s Q"

  shows "P[<s>] ↝«weakBisim» Q[<s>]"
  and   "Q[<s>] ↝«weakBisim» P[<s>]"
proof -
  from assms show "P[<s>] ↝«weakBisim» Q[<s>]" by(simp add: weakCongruenceSubst_def weakCongruence_def)
next
  from assms show "Q[<s>] ↝«weakBisim» P[<s>]" by(simp add: weakCongruenceSubst_def weakCongruence_def)
qed

lemma unfoldI:
  fixes P :: pi
  and   Q :: pi

  assumes "s. P[<s>] ↝«weakBisim» Q[<s>]"
  and     "s. Q[<s>] ↝«weakBisim» P[<s>]"

  shows "P s Q"
using assms
by(simp add: weakCongruenceSubst_def weakCongruence_def)

lemma weakCongWeakEq:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"

  shows "P  Q"
using assms
apply(simp add: weakCongruenceSubst_def weakCongruence_def)
apply(erule_tac x="[]" in allE)
by auto

lemma eqvtI:
  fixes P :: pi
  and   Q :: pi
  and   p :: "name prm"

  assumes "P s Q"

  shows "(p  P) s (p  Q)"
proof(simp add: weakCongruenceSubst_def, rule allI)
  fix s
  from assms have "P[<(rev p  s)>]  Q[<(rev p  s)>]" by(auto simp add: weakCongruenceSubst_def)
  thus "(p  P)[<s>]  (p  Q)[<s>]" by(drule_tac p=p in Weak_Early_Cong.eqvtI) (simp add: eqvts name_per_rev)
qed

lemma strongEqWeakCong:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "P s Q"
using assms
by(auto intro: strongBisimWeakCong simp add: substClosed_def weakCongruenceSubst_def)

lemma congSubstBisimSubst:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "P s Q"
using assms
by(auto intro: congruenceWeakBisim simp add: substClosed_def weakCongruenceSubst_def)

lemma reflexive:
  fixes P :: pi
  
  shows "P s P"
proof -
  from Weak_Early_Bisim.reflexive have "P. P ↝«weakBisim» P"
    by(blast intro: Weak_Early_Step_Sim.reflexive)
  thus ?thesis
    by(force simp add: weakCongruenceSubst_def weakCongruence_def)
qed

lemma symetric:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"
  
  shows "Q s P"
using assms by(auto simp add: weakCongruenceSubst_def weakCongruence_def)

lemma transitive:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  assumes "P s Q"
  and     "Q s R"
  
  shows "P s R"
using assms by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong.transitive)

lemma partUnfold:
  fixes P :: pi
  and   Q :: pi
  and   s :: "(name × name) list"

  assumes "P s Q"

  shows "P[<s>] s Q[<s>]"
using assms
proof(auto simp add: weakCongruenceSubst_def)
  fix s'
  assume "s. P[<s>]  Q[<s>]"
  hence "P[<(s@s')>]  Q[<(s@s')>]" by blast
  moreover have "P[<(s@s')>] = (P[<s>])[<s'>]"
    by(induct s', auto)
  moreover have "Q[<(s@s')>] = (Q[<s>])[<s'>]"
    by(induct s', auto)
  
  ultimately show "(P[<s>])[<s'>]  (Q[<s>])[<s'>]"
    by simp
qed

end

Theory Weak_Early_Step_Sim_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Step_Sim_Pres
  imports Weak_Early_Step_Sim
begin

lemma tauPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "τ.(P) ↝«Rel» τ.(Q)"
proof(induct rule: simCases)
  case(Bound a x Q')
  have "τ.(Q) ax>  Q'" by fact
  hence False by(induct rule: tauCases', auto)
  thus ?case by simp
next
  case(Free α Q')
  have "τ.(Q) (α  Q')" by fact
  thus ?case
  proof(induct rule: tauCases', auto simp add: pi.inject residual.inject)
    have "τ.(P)  τ  P" by(rule Weak_Early_Step_Semantics.Tau)
    with PRelQ show "P'. τ.(P)  τ  P'  (P', Q)  Rel" by blast
  qed
qed

lemma inputPres:
  fixes P    :: pi
  and   x    :: name
  and   Q    :: pi
  and   a    :: name
  and   Rel  :: "(pi × pi) set"

  assumes PRelQ: "y. (P[x::=y], Q[x::=y])  Rel"
  and     Eqvt: "eqvt Rel"

  shows "a<x>.P ↝«Rel» a<x>.Q"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, a, P, Q)"])
  case(Bound b y Q')
  from y  (x, a, P, Q) have "y  x" "y  a" "y  P" "y  Q" by simp+
  from a<x>.Q by>  Q' y  a y  x y  Q show ?case
    by(erule_tac inputCases') auto
next
  case(Free α Q')
  from a<x>.Q  α  Q'
  show ?case
  proof(induct rule: inputCases)
    case(cInput u)
    have "a<x>.P (a<u>)  (P[x::=u])"
      by(rule Weak_Early_Step_Semantics.Input)
    moreover from PRelQ have "(P[x::=u], Q[x::=u])  Rel" by auto
    ultimately show ?case by blast
  qed
qed

lemma outputPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "a{b}.P ↝«Rel» a{b}.Q"
proof(induct rule: simCases)
  case(Bound c x Q')
  have "a{b}.Q cx>  Q'" by fact
  hence False by(induct rule: outputCases', auto)
  thus ?case by simp
next
  case(Free α Q')
  have "a{b}.Q α  Q'" by fact
  thus "P'. a{b}.P  α  P'  (P', Q')  Rel"
  proof(induct rule: outputCases', auto simp add: pi.inject residual.inject)
    have "a{b}.P  a[b]  P" by(rule Weak_Early_Step_Semantics.Output)
    with PRelQ show "P'. a{b}.P  a[b]  P'  (P', Q)  Rel" by blast
  qed
qed

lemma matchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝«Rel» Q"
  and     RelRel': "Rel  Rel'"

  shows "[ab]P ↝«Rel'» [ab]Q"
proof(induct rule: simCases)
  case(Bound c x Q')
  have "x  [ab]P" by fact
  hence xFreshP: "(x::name)  P" by simp
  have "[ab]Q cx>  Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case Match
    have "Q cx>  Q'" by fact
    with PSimQ xFreshP obtain P' where PTrans: "P cx>  P'"
                                   and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans have "[aa]P cx>  P'" by(rule Weak_Early_Step_Semantics.Match)
    moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by blast
    ultimately show ?case by blast
  qed
next
  case(Free α Q')
  have "[ab]Q α  Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case Match
    have "Q  α  Q'" by fact
    with PSimQ obtain P' where PTrans: "P α  P'" and PRel: "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans have "[aa]P α  P'" by(rule Weak_Early_Step_Semantics.Match)
    with RelRel' PRel show ?case by blast
  qed
qed

lemma mismatchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝«Rel» Q"
  and     RelRel': "Rel  Rel'"

  shows "[ab]P ↝«Rel'» [ab]Q"
proof(induct rule: simCases)
  case(Bound c x Q')
  have "x  [ab]P" by fact
  hence xFreshP: "(x::name)  P" by simp
  have "[ab]Q cx>  Q'" by fact
  thus ?case
  proof(induct rule: mismatchCases)
    case Mismatch
    have aineqb: "a  b" by fact
    have "Q cx>  Q'" by fact
    with PSimQ xFreshP obtain P' where PTrans: "P cx>  P'"
                                   and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans aineqb have "[ab]P cx>  P'" by(rule Weak_Early_Step_Semantics.Mismatch)
    moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by blast
    ultimately show ?case by blast
  qed
next
  case(Free α Q')
  have "[ab]Q α  Q'" by fact
  thus ?case
  proof(induct rule: mismatchCases)
    case Mismatch
    have "Q α  Q'" by fact
    with PSimQ obtain P' where PTrans: "P α  P'" and PRel: "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans a  b have "[ab]P α  P'" by(rule Weak_Early_Step_Semantics.Mismatch)
    with RelRel' PRel show ?case by blast
  qed
qed

lemma sumPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes PSimQ: "P ↝«Rel» Q"
  and     RelRel': "Rel  Rel'"
  and     C: "Id  Rel'"

  shows "P  R ↝«Rel'» Q  R"
proof(induct rule: simCases)
  case(Bound a x Q')
  have "x  P  R" by fact
  hence xFreshP: "(x::name)  P" and xFreshR: "x  R" by simp+
  have "Q  R ax>  Q'" by fact
  thus ?case
  proof(induct rule: sumCases)
    case Sum1
    have "Q ax>  Q'" by fact
    with xFreshP PSimQ obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans have "P  R ax>  P'" by(rule Weak_Early_Step_Semantics.Sum1)
    moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by blast
    ultimately show ?case by blast
  next
    case Sum2
    from R ax>  Q' have "P  R ax>  Q'" by(rule Early_Semantics.Sum2)
    hence "P  R ax>  Q'" by(rule Weak_Early_Step_Semantics.singleActionChain)
    moreover from C have "(Q', Q')  Rel'" by blast
    ultimately show ?case by blast
  qed
next
  case(Free α Q')
  have "Q  R α  Q'" by fact
  thus ?case
  proof(induct rule: sumCases)
    case Sum1
    have "Q α  Q'" by fact
    with PSimQ obtain P' where PTrans: "P α  P'" and PRel: "(P', Q')  Rel" 
      by(blast dest: simE)
    from PTrans have "P  R α  P'" by(rule Weak_Early_Step_Semantics.Sum1)
    with RelRel' PRel show ?case by blast
  next
    case Sum2
    from R α  Q' have "P  R α  Q'" by(rule Early_Semantics.Sum2)
    hence "P  R α  Q'" by(rule Weak_Early_Step_Semantics.singleActionChain)
    moreover from C have "(Q', Q')  Rel'" by blast
    ultimately show ?case by blast
  qed
qed
      
lemma parPres:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   T     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"
  
  assumes PSimQ:    "P ↝«Rel» Q"
  and     PRelQ:    "(P, Q)  Rel"
  and     Par:      "S T U. (S, T)  Rel  (S  U, T  U)  Rel'"
  and     Res:      "S T x. (S, T)  Rel'  (x>S, x>T)  Rel'"

  shows "P  R ↝«Rel'» Q  R"
proof -
  show ?thesis
  proof(induct rule: simCases)
    case(Bound a x Q')
    have "x  P  R" by fact
    hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
    have "Q  R ax>  Q'" by fact
    thus ?case
    proof(induct rule: parCasesB)
      case(cPar1 Q')
      have QTrans: "Q  ax>  Q'" by fact
      from xFreshP PSimQ QTrans obtain P' where PTrans:"P  ax>  P'"
                                            and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans xFreshR have "P  R  ax>  (P'  R)" by(rule Weak_Early_Step_Semantics.Par1B)
      moreover from P'RelQ' have "(P'  R, Q'  R)  Rel'" by(rule Par)
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from R  ax>  R' x  P have "P  R ax>  (P  R')"
        by(rule Early_Semantics.Par2B)
      hence "P  R  ax>  (P  R')" by(rule Weak_Early_Step_Semantics.singleActionChain)
      moreover from PRelQ have "(P  R', Q   R')  Rel'" by(rule Par)
      ultimately show ?case by blast
    qed
  next
    case(Free α QR')
    have "Q  R  α  QR'" by fact
    thus ?case
    proof(induct rule: parCasesF[of _ _ _ _ _ "(P, R)"])
      case(cPar1 Q')
      have "Q  α  Q'" by fact
      with PSimQ obtain P' where PTrans: "P  α  P'" and PRel: "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans have Trans: "P  R  α  P'  R" by(rule Weak_Early_Step_Semantics.Par1F)
      moreover from PRel have "(P'  R, Q'  R)  Rel'" by(blast intro: Par)
      ultimately show ?case by blast
    next
      case(cPar2 R')
      from R α  R' have "P  R α  (P  R')"
        by(rule Early_Semantics.Par2F)
      hence "P  R α  (P  R')" by(rule Weak_Early_Step_Semantics.singleActionChain)
      moreover from PRelQ have "(P  R', Q   R')  Rel'" by(rule Par)
      ultimately show ?case by blast
    next
      case(cComm1 Q' R' a b)
      have QTrans: "Q  a<b>  Q'" and RTrans: "R  a[b]  R'" by fact+

      from PSimQ QTrans obtain P' where PTrans: "P a<b>  P'"
                                    and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      from RTrans have "R a[b]  R'" by(rule Weak_Early_Step_Semantics.singleActionChain)
      with PTrans have "P  R  τ  P'  R'" by(rule Weak_Early_Step_Semantics.Comm1)
      moreover from P'RelQ' have "(P'  R', Q'  R')  Rel'" by(rule Par)
      ultimately show ?case by blast
    next
      case(cComm2 Q' R' a b)
      have QTrans: "Q a[b]  Q'" and RTrans: "R a<b>  R'" by fact+
      
      from PSimQ QTrans obtain P' where PTrans: "P a[b]  P'"
                                    and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      
      from RTrans have "R a<b>  R'" by(rule Weak_Early_Step_Semantics.singleActionChain)
      with PTrans have "P  R  τ  P'  R'" by(rule Weak_Early_Step_Semantics.Comm2)
      moreover from P'RelQ' have "(P'  R', Q'  R')  Rel'" by(rule Par)
      ultimately show ?case by blast
    next
      case(cClose1 Q' R' a x)
      have QTrans: "Q a<x>  Q'" and RTrans: "R ax>  R'" by fact+
      have "x  (P, R)" by fact
      hence xFreshP: "x  P" and xFreshR: "x  R" by(simp add: fresh_prod)+
      
      from PSimQ QTrans obtain P' where PTrans: "P a<x>  P'"
                                    and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      
      from RTrans have "R ax>  R'" by(rule Weak_Early_Step_Semantics.singleActionChain)
      with PTrans have Trans: "P  R  τ  x>(P'  R')" using x  P
        by(rule Weak_Early_Step_Semantics.Close1)
      moreover from P'RelQ' have "(x>(P'  R'), x>(Q'  R'))  Rel'"
        by(blast intro: Par Res)
      ultimately show ?case by blast
    next
      case(cClose2 Q' R' a x)
      have QTrans: "Q ax>  Q'" and RTrans: "R a<x>  R'" by fact+
      have "x  (P, R)" by fact
      hence xFreshR: "x  R" and xFreshP: "x  P" by(simp add: fresh_prod)+

      from PSimQ QTrans xFreshP obtain P' where PTrans: "P ax>  P'"
                                            and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      
      from RTrans have "R a<x>  R'" by(rule Weak_Early_Step_Semantics.singleActionChain)
      with PTrans have Trans: "P  R τ  x>(P'  R')" using x  R
        by(rule Weak_Early_Step_Semantics.Close2)
      moreover from P'RelQ' have "(x>(P'  R'), x>(Q'  R'))  Rel'"
        by(blast intro: Par Res)
      ultimately show ?case by blast
    qed
  qed
qed

lemma resPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   x    :: name
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝«Rel» Q"
  and     C1: "R S x. (R, S)  Rel  (x>R, x>S)  Rel'"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel: "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "x>P ↝«Rel'» x>Q"
proof -
  from EqvtRel' show ?thesis
  proof(induct rule: simCasesCont[of _ "(P, x)"])
    case(Bound a y Q')
    have Trans: "x>Q ay>  Q'" by fact
    have "y  (P, x)" by fact
    hence yineqx: "y  x" and yFreshP: "y  P" by(simp add: fresh_prod)+
    from Trans yineqx show ?case
    proof(induct rule: resCasesB)
      case(Open Q')
      have QTrans: "Q a[x]  Q'" and aineqx: "a  x" by fact+

      from PSimQ QTrans obtain P' where PTrans: "P a[x]  P'"
                                    and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)

      from PTrans aineqx have "x>P ax>  P'" by(rule Weak_Early_Step_Semantics.Open)
      hence "x>P ay>  ([(y, x)]  P')" using y  P y  x
        by(force simp add: weakTransitionAlpha abs_fresh name_swap)

      moreover from EqvtRel P'RelQ' RelRel' have "([(y, x)]  P', [(y, x)]  Q')  Rel'"
        by(blast intro: eqvtRelI)
      ultimately show ?case by blast
    next
      case(Res Q')
      have QTrans: "Q ay>  Q'" and xineqa: "x  a" by fact+

      from PSimQ yFreshP QTrans obtain P' where PTrans: "P ay>  P'"
                                            and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans xineqa yineqx yFreshP have ResTrans: "x>P ay>  (x>P')"
        by(blast intro: Weak_Early_Step_Semantics.ResB)
      moreover from P'RelQ' have "((x>P'), (x>Q'))  Rel'"
        by(rule C1)
      ultimately show ?case by blast
    qed
  next
    case(Free α Q')
    have QTrans: "x>Q  α  Q'" by fact
    have "c::name. c  (P, Q, Q', α)" by(blast intro: name_exists_fresh)
    then obtain c::name where cFreshQ: "c  Q" and cFreshAlpha: "c  α" and cFreshQ': "c  Q'" and cFreshP: "c  P"
      by(force simp add: fresh_prod)
    from cFreshP have "x>P = c>([(x, c)]  P)" by(simp add: alphaRes)
    moreover have "P'.c>([(x, c)]  P)  α  P'  (P', Q')  Rel'"
    proof -
      from QTrans cFreshQ have "c>([(x, c)]  Q) α  Q'" by(simp add: alphaRes)
      moreover have "c  α" by(rule cFreshAlpha)
      moreover from PSimQ EqvtRel have "([(x, c)]  P) ↝«Rel» ([(x, c)]  Q)"
        by(blast intro: eqvtI)
      ultimately show ?thesis
        apply(induct rule: resCasesF, auto simp add: residual.inject pi.inject name_abs_eq)
        by(blast intro: Weak_Early_Step_Semantics.ResF C1 dest: simE)
    qed

    ultimately show ?case by force
  qed
qed

lemma resChainI:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   lst :: "name list"

  assumes eqvtRel: "eqvt Rel"
  and     Res:     "R S x. (R, S)  Rel  (x>R, x>S)  Rel"
  and     PRelQ:   "P ↝«Rel» Q"

  shows "(resChain lst) P ↝«Rel» (resChain lst) Q"
proof -
  show ?thesis
  proof(induct lst) (* Base case *)
    from PRelQ show "resChain [] P ↝«Rel» resChain [] Q" by simp
  next (* Inductive step *)
    fix a lst
    assume IH: "(resChain lst P) ↝«Rel» (resChain lst Q)"
    moreover from Res have "P Q a. (P, Q)  Rel  (a>P, a>Q)  Rel"
      by simp
    moreover have "Rel  Rel" by simp
    ultimately have "a>(resChain lst P) ↝«Rel» a>(resChain lst Q)" using eqvtRel
      by(rule_tac resPres)

    thus "resChain (a # lst) P ↝«Rel» resChain (a # lst) Q"
      by simp
  qed
qed

lemma bangPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
 
  assumes PRelQ:    "(P, Q)  Rel"
  and     Sim:      "R S. (R, S)  Rel  R ↝«Rel'» S"
  and     C1:       "Rel  Rel'"
  and     eqvtRel:  "eqvt Rel'"

  shows "!P ↝«bangRel Rel'» !Q"
proof -
  let ?Sim = "λP Rs. (a x Q'. Rs = ax>  Q'  x  P  (P'. P ax>  P'  (P', Q')  bangRel Rel')) 
                     (α Q'. Rs = α  Q'  (P'. P α  P'  (P', Q')  bangRel Rel'))"
  from eqvtRel have EqvtBangRel: "eqvt(bangRel Rel')" by(rule eqvtBangRel)
  from C1 have BRelRel': "P Q. (P, Q)  bangRel Rel  (P, Q)  bangRel Rel'"
    by(auto intro: bangRelSubset)

  {
    fix Pa Rs
    assume "!Q  Rs" and "(Pa, !Q)  bangRel Rel"
    hence "?Sim Pa Rs" using PRelQ 
    proof(nominal_induct avoiding: Pa P rule: bangInduct)
      case(Par1B a x Q' Pa P)
      have QTrans: "Q  ax>  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" and "x  Pa" by fact+
      thus "?Sim Pa (ax>  (Q'  !Q))"
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" by fact
        have PBRQ: "(R, !Q)  bangRel Rel" by fact
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        show ?case 
        proof(auto simp add: residual.inject alpha')
          from PRelQ have "P ↝«Rel'» Q" by(rule Sim)

          with QTrans xFreshP obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel'"
            by(blast dest: simE)

          from PTrans xFreshR have "P  R ax>  (P'  R)"
            by(force intro: Weak_Early_Step_Semantics.Par1B)
          moreover from P'RelQ' PBRQ BRelRel' have "(P'  R, Q'  !Q)  bangRel Rel'" by(blast intro: Rel.BRPar)
          ultimately show "P'. P  R ax>  P'  (P', Q'  !Q)  bangRel Rel'" by blast
        next
          fix y
          assume "(y::name)  Q'" and "y  P" and "y  R" and "y  Q"
          from QTrans y  Q' have "Q ay>  ([(x, y)]  Q')"
            by(simp add: alphaBoundOutput)
          moreover from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
          ultimately obtain P' where PTrans: "P ay>  P'" and P'RelQ': "(P', [(x, y)]  Q')  Rel'"
            using y  P
            by(blast dest: simE)
          from PTrans y  R have "P  R ay>  (P'  R)" by(force intro: Weak_Early_Step_Semantics.Par1B)
          moreover from P'RelQ' PBRQ BRelRel' have "(P'  R, ([(x, y)]  Q')  !Q)  bangRel Rel'" by(metis Rel.BRPar)
          with x  Q y  Q have "(P'  R, ([(y, x)]  Q')  !([(y, x)]  Q))  bangRel Rel'"
            by(simp add: name_fresh_fresh name_swap)
          ultimately show "P'. P  R ay>  P'  (P', ([(y, x)]  Q')  !([(y, x)]  Q))  bangRel Rel'"
            by blast
        qed
      qed
    next
      case(Par1F α Q' Pa P)
      have QTrans: "Q α  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and BR: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P α  P'" and RRel: "(P', Q')  Rel'"
            by(blast dest: simE)
          
          from PTrans have "P  R α  P'  R" by(rule Weak_Early_Step_Semantics.Par1F)
          moreover from RRel BR BRelRel' have "(P'  R, Q'  !Q)  bangRel Rel'" by(metis Rel.BRPar)
          ultimately show "P'. P  R α  P'  (P', Q'  !Q)  bangRel Rel'" by blast
        qed
      qed
    next
      case(Par2B a x Q' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (ax>  Q')" by simp
      have "(Pa, Q  !Q)  bangRel Rel" and "x  Pa" by fact+
      thus "?Sim Pa (ax>  (Q  Q'))"
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+

        from EqvtBangRel show "?Sim (P  R) (ax>  (Q  Q'))"
        proof(auto simp add: residual.inject alpha')
          from RBRQ have "?Sim R (ax>  Q')" by(rule IH)
          with xFreshR obtain R' where RTrans: "R ax>  R'" and R'BRQ': "(R', Q')  (bangRel Rel')"
            by(metis simE)
          from RTrans xFreshP have "P  R ax>  (P  R')" by(auto intro: Weak_Early_Step_Semantics.Par2B)
          moreover from PRelQ R'BRQ' C1 have "(P  R', Q  Q')  (bangRel Rel')" by(blast dest: Rel.BRPar)
          ultimately show "P'. P  R ax>  P'  (P', Q  Q')  bangRel Rel'" by blast
        next
          fix y
          assume "(y::name)  Q" and "y  Q'" and "y  P" and "y  R"
          from RBRQ have "?Sim R (ax>  Q')" by(rule IH)
          with y  Q' have "?Sim R (ay>  ([(x, y)]  Q'))" by(simp add: alphaBoundOutput)
          with y  R obtain R' where RTrans: "R ay>  R'" and R'BRQ': "(R', ([(x, y)]  Q'))  (bangRel Rel')"
            by(metis simE)
          from RTrans y  P have "P  R ay>  (P  R')" by(auto intro: Weak_Early_Step_Semantics.Par2B)
          moreover from PRelQ R'BRQ' C1 have "(P  R', Q  ([(x, y)]  Q'))  (bangRel Rel')" by(blast dest: Rel.BRPar)
          with y  Q x  Q have "(P  R', ([(y, x)]  Q)  ([(y, x)]  Q'))  (bangRel Rel')"
            by(simp add: name_swap name_fresh_fresh)
          ultimately show "P'. P  R ay>  P'  (P', ([(y, x)]  Q)  ([(y, x)]  Q'))  bangRel Rel'" by blast
        qed
      qed
    next
      case(Par2F α Q' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (α  Q')" by simp
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from RBRQ IH have "R'. R α  R'  (R', Q')  bangRel Rel'"
            by(metis simE)
          then obtain R' where RTrans: "R α  R'" and R'RelQ': "(R', Q')  bangRel Rel'"
            by blast

          from RTrans have "P  R α  P  R'" by(rule Weak_Early_Step_Semantics.Par2F)
          moreover from PRelQ R'RelQ' C1 have "(P  R', Q  Q')  bangRel Rel'" by(blast dest: Rel.BRPar)
          ultimately show " P'. P  R α  P'  (P', Q  Q')  bangRel Rel'" by blast
        qed
      qed
    next
      case(Comm1 a Q' b Q'' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (a[b]  Q'')" by simp
      have QTrans: "Q a<b>  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P a<b>  P'" and P'RelQ': "(P', Q')  Rel'"
            by(blast dest: simE)
          
          from IH RBRQ have RTrans: "R'. R a[b]  R'  (R', Q'')  bangRel Rel'"
            by(metis simE)
          then obtain R' where RTrans: "R a[b]  R'" and R'RelQ'': "(R', Q'')  bangRel Rel'"
            by blast
          
          from PTrans RTrans have "P  R τ  P'  R'" by(rule Weak_Early_Step_Semantics.Comm1)
          moreover from P'RelQ' R'RelQ'' have "(P'  R', Q'  Q'')  bangRel Rel'" by(rule Rel.BRPar)
          ultimately show "P'. P  R τ  P'  (P', Q'  Q'')  bangRel Rel'" by blast
        qed
      qed
    next
      case(Comm2 a b Q' Q'')
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (a<b>  Q'')" by simp
      have QTrans: "Q  a[b]  Q'" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P a[b]  P'" and P'RelQ': "(P', Q')  Rel'"
            by(blast dest: simE)

          from IH RBRQ have RTrans: "R'. R a<b>  R'  (R', Q'')  bangRel Rel'"
            by(metis simE)
          then obtain R' where RTrans: "R a<b>  R'" and R'RelQ'': "(R', Q'')  bangRel Rel'"
            by blast

          from PTrans RTrans have "P  R τ  P'  R'" by(rule Weak_Early_Step_Semantics.Comm2)
          moreover from P'RelQ' R'RelQ'' have "(P'  R', Q'  Q'')  bangRel Rel'" by(rule Rel.BRPar)
          ultimately show "P'. P  R τ  P'  (P', Q'  Q'')  bangRel Rel'" by blast
        qed
      qed
    next
      case(Close1 a x Q' Q'' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (ax>  Q'')" by simp
      have QTrans: "Q  a<x>  Q'" by fact
      have xFreshQ: "x  Q" by fact
      have "(Pa, Q  !Q)  bangRel Rel" by fact
      moreover have xFreshPa: "x  Pa" by fact
      ultimately show ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
          with QTrans xFreshP obtain P' where PTrans: "P a<x>  P'" and P'RelQ': "(P', Q')  Rel'"
             by(blast dest: simE)

           from RBRQ xFreshR IH have "R'. R ax>  R'  (R', Q'')  bangRel Rel'"
             by(metis simE)
           then obtain R' where RTrans: "R ax>  R'" and R'RelQ'': "(R', Q'')  bangRel Rel'"
             by blast

           from PTrans RTrans xFreshP have "P  R τ  x>(P'  R')"
             by(rule Weak_Early_Step_Semantics.Close1)   
           moreover from P'RelQ' R'RelQ'' have "(x>(P'  R'), x>(Q'  Q''))  bangRel Rel'"
             by(force intro: Rel.BRPar BRRes)
           ultimately show "P'. P  R τ  P'  (P', x>(Q'  Q''))  bangRel Rel'" by blast
         qed
      qed
    next
      case(Close2 a x Q' Q'' Pa P)
      hence IH: "Pa. (Pa, !Q)  bangRel Rel  ?Sim Pa (a<x>  Q'')" by simp
      have QTrans: "Q  ax>  Q'" by fact
      have xFreshQ: "x  Q" by fact
      have "(Pa, Q  !Q)  bangRel Rel" and "x  Pa" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBRQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
          with QTrans xFreshP obtain P' where PTrans: "P ax>  P'" and P'RelQ': "(P', Q')  Rel'"
            by(blast dest: simE)

          from RBRQ IH have "R'.  R a<x>  R'  (R', Q'')  bangRel Rel'"
            by auto
          then obtain R' where RTrans: "R a<x>  R'" and R'RelQ'': "(R', Q'')  bangRel Rel'"
            by blast

          from PTrans RTrans xFreshR have "P  R τ  x>(P'  R')"
            by(rule Weak_Early_Step_Semantics.Close2)    
          moreover from P'RelQ' R'RelQ'' have "(x>(P'  R'), x>(Q'  Q''))  bangRel Rel'"
            by(force intro: Rel.BRPar BRRes)
          ultimately show "P'. P  R τ  P'  (P', x>(Q'  Q''))  bangRel Rel'" by blast
        qed
      qed
    next
      case(Bang Rs Pa P)
      hence IH: "Pa. (Pa, Q  !Q)  bangRel Rel  ?Sim Pa Rs" by simp
      have "(Pa, !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRBangCases)
        case(BRBang P)
        have PRelQ: "(P, Q)  Rel" by fact
        hence "(!P, !Q)  bangRel Rel" by(rule Rel.BRBang)
        with PRelQ have "(P  !P, Q  !Q)  bangRel Rel" by(rule BRPar)
        with IH have "?Sim (P  !P) Rs" by simp
        thus ?case by(force intro: Weak_Early_Step_Semantics.Bang)
      qed
    qed
  }

  moreover from PRelQ have "(!P, !Q)  bangRel Rel" by(rule BRBang) 
  ultimately show ?thesis by(auto simp add: weakStepSimulation_def)
qed
(*
lemma bangPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"
 
  assumes PRelQ:      "(P, Q) ∈ Rel"
  and     Sim:        "⋀P Q. (P, Q) ∈ Rel ⟹ P ↝<Rel'> Q"
  and     RelRel':    "⋀P Q. (P, Q) ∈ Rel ⟹ (P, Q) ∈ Rel'"
  and     eqvtRel':   "eqvt Rel'"

  shows "!P ↝<bangRel Rel'> !Q"
proof -
  from eqvtRel' have EqvtBangRel': "eqvt (bangRel Rel')" by(rule eqvtBangRel)
  from RelRel' have BRelRel': "⋀P Q. (P, Q) ∈ bangRel Rel ⟹ (P, Q) ∈ bangRel Rel'"
    by(auto intro: bangRelSubset)
  have "⋀Rs P. ⟦!Q ⟼ Rs; (P, !Q) ∈ bangRel Rel⟧ ⟹ weakSimStepAct P Rs P (bangRel Rel')"
  proof -
    fix Rs P
    assume "!Q ⟼ Rs" and "(P, !Q) ∈ bangRel Rel"
    thus "weakSimStepAct P Rs P (bangRel Rel')"
    proof(nominal_induct avoiding: P rule: bangInduct)
      case(Par1B a x Q')
      have QTrans: "Q ⟼a<νx> ≺ Q'" and xFreshQ: "x ♯ Q" by fact
      have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) ∈ Rel" and RBangRelT: "(R, !Q) ∈ bangRel Rel" by fact
        have "x ♯ P ∥ R" by fact
        hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
        from PRelQ have PSimQ: "P ↝<Rel'> Q" by(rule Sim)
        from EqvtBangRel' show ?case
        proof(induct rule: simActBoundCases)
          case BoundOutput
          with PSimQ QTrans xFreshP obtain P' where PTrans: "P ⟹a<νx> ≺ P'"
                                                and P'RelQ': "(P', Q') ∈ Rel'"
            by(blast dest: simE)
          from PTrans xFreshR have "P ∥ R ⟹a<νx>≺ (P' ∥ R)"
            by(rule Weak_Early_Step_Semantics.Par1B)
          moreover from P'RelQ' RBangRelT have "(P' ∥ R, Q' ∥ !Q) ∈ bangRel Rel'"
            by(blast intro: Rel.BRPar BRelRel')
          ultimately show ?case by blast
        qed
      qed
    next
      case(Par1F α Q' P)
      have QTrans: "Q ⟼α ≺ Q'" by fact
      have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P ⟹α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel'"
            by(blast dest: simE)

          from PTrans have "P ∥ R ⟹α ≺ P' ∥ R" by(rule Weak_Early_Step_Semantics.Par1F)
          moreover from P'RelQ' RBangRelQ have "(P' ∥ R, Q' ∥ !Q) ∈ bangRel Rel'"
            by(blast intro: Rel.BRPar BRelRel')
          ultimately show ?case by blast
        qed
      qed
    next
      case(Par2B a x Q' P)
      have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimStepAct P (a<νx> ≺ Q') P (bangRel Rel')" by fact
      have xFreshQ: "x ♯ Q" by fact
      have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact
        have "x ♯ P ∥ R" by fact
        hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
        from EqvtBangRel' show ?case
        proof(induct rule: simActBoundCases)
          case BoundOutput
          with IH RBangRelQ have "weakSimStepAct R (a<νx> ≺ Q') R (bangRel Rel')" by blast
          with xFreshR obtain R' where RTrans: "R ⟹a<νx> ≺ R'"
                                   and R'BangRelQ': "(R', Q') ∈ bangRel Rel'"
            by(simp add: weakSimStepAct_def, blast)
          
          from RTrans xFreshP have "P ∥ R ⟹a<νx> ≺ (P ∥ R')"
            by(auto intro: Weak_Early_Step_Semantics.Par2B)
          moreover from PRelQ R'BangRelQ' have "(P ∥ R', Q ∥ Q') ∈ (bangRel Rel')"
            by(blast intro: Rel.BRPar RelRel')
          ultimately show ?case by blast
        qed
      qed
    next
      case(Par2F α Q' P)
      have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimStepAct P (α ≺ Q') P (bangRel Rel')" by fact
      have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from RBangRelQ have "weakSimStepAct R (α ≺ Q') R (bangRel Rel')" by(rule IH)
          then obtain R' where RTrans: "R ⟹α ≺ R'" and R'RelQ': "(R', Q') ∈ (bangRel Rel')"
            by(simp add: weakSimStepAct_def, blast)

          from RTrans have "P ∥ R ⟹α ≺ P ∥ R'" by(rule Weak_Early_Step_Semantics.Par2F)
          moreover from PRelQ R'RelQ' have "(P ∥ R', Q ∥ Q') ∈ (bangRel Rel')" 
            by(blast intro: Rel.BRPar RelRel')
          ultimately show ?case by blast
        qed
      qed
    next
      case(Comm1 a Q' b Q'' P)
      have QTrans: "Q ⟼ a<b> ≺ Q'" by fact
      have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimStepAct P (a[b] ≺ Q'') P (bangRel Rel')" by fact
      have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P ⟹a<b> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel'"
            by(blast dest: simE)

          from RBangRelQ have "weakSimStepAct R (a[b] ≺ Q'') R (bangRel Rel')" by(rule IH)
          then obtain R' where RTrans: "R ⟹a[b] ≺ R'"
                           and R'RelQ'': "(R', Q'') ∈ (bangRel Rel')"
            by(simp add: weakSimStepAct_def, blast)
        
          from PTrans RTrans have "P ∥ R ⟹τ ≺ (P' ∥ R')"
            by(rule Weak_Early_Step_Semantics.Comm1)
          moreover from P'RelQ' R'RelQ'' have "(P' ∥ R', Q' ∥ Q'') ∈ (bangRel Rel')"
            by(rule Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(Comm2 a b Q' Q'' P)
      have QTrans: "Q ⟼a[b] ≺ Q'" by fact
      have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimStepAct P (a<b> ≺ Q'') P (bangRel Rel')" by fact
      have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P ⟹a[b] ≺ P'" and P'RelQ': "(P', Q') ∈ Rel'"
            by(blast dest: simE)

          from RBangRelQ have "weakSimStepAct R (a<b> ≺ Q'') R (bangRel Rel')" by(rule IH)
          then obtain R' where RTrans: "R ⟹a<b> ≺ R'" and R'BangRelQ'': "(R', Q'') ∈ (bangRel Rel')"
            by(simp add: weakSimStepAct_def, blast)
        
          from PTrans RTrans have "P ∥ R ⟹τ ≺ (P' ∥ R')"
            by(rule Weak_Early_Step_Semantics.Comm2)
          moreover from P'RelQ' R'BangRelQ'' have "(P' ∥ R', Q' ∥ Q'') ∈ (bangRel Rel')"
            by(rule Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(Close1 a x Q' Q'' P)
      have QTrans: "Q ⟼ a<x> ≺ Q'" by fact
      have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimStepAct P (a<νx> ≺ Q'') P (bangRel Rel')" by fact
      have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact
        have "x ♯ P ∥ R" by fact
        hence xFreshR: "x ♯ R" and xFreshP: "x ♯ P" by simp+
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P ⟹a<x> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel'"
            by(blast dest: simE)
          
          from RBangRelQ have "weakSimStepAct R (a<νx> ≺ Q'') R (bangRel Rel')" by(rule IH)
          with xFreshR obtain R' where RTrans: "R ⟹a<νx> ≺ R'"
                                   and R'RelQ'': "(R', Q'') ∈ (bangRel Rel')"
            by(simp add: weakSimStepAct_def, blast)
        
          from PTrans RTrans xFreshP xFreshR have "P ∥ R ⟹τ ≺ <νx>(P' ∥ R')"
            by(rule Weak_Early_Step_Semantics.Close1)
          moreover from P'RelQ' R'RelQ'' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ Q'')) ∈ (bangRel Rel')"
            by(force intro: Rel.BRPar Rel.BRRes)
          ultimately show ?case by blast
        qed
      qed
    next
      case(Close2 a x Q' Q'' P)
      have QTrans: "Q ⟼ a<νx> ≺ Q'" by fact
      have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimStepAct P (a<x> ≺ Q'') P (bangRel Rel')" by fact
      have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact
        have "x ♯ P ∥ R" by fact
        hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
        show ?case
        proof(induct rule: simActFreeCases)
          case Der
          from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
          with QTrans xFreshP obtain P' where PTrans: "P ⟹a<νx> ≺ P'"
                                          and P'RelQ': "(P', Q') ∈ Rel'"
            by(blast dest: simE)

          from RBangRelQ have "weakSimStepAct R (a<x> ≺ Q'') R (bangRel Rel')" by(rule IH)
          with xFreshR obtain R' where RTrans: "R ⟹a<x> ≺ R'"
                                       and R'RelQ'': "(R', Q'') ∈ (bangRel Rel')"
            by(simp add: weakSimStepAct_def, blast)
        
          from PTrans RTrans xFreshP xFreshR have "P ∥ R ⟹τ ≺ <νx>(P' ∥ R')"
            by(rule Weak_Early_Step_Semantics.Close2)
          moreover from P'RelQ' R'RelQ'' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ Q'')) ∈ (bangRel Rel')"
            by(force intro: Rel.BRPar Rel.BRRes)
          ultimately show ?case by blast
        qed
      qed
    next
      case(Bang Rs)
      have IH: "⋀P. (P, Q ∥ !Q) ∈ bangRel Rel ⟹ weakSimStepAct P Rs P (bangRel Rel')" by fact
      have "(P, !Q) ∈ bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRBangCases)
        case(BRBang P)
        have PRelQ: "(P, Q) ∈ Rel" by fact
        hence "(!P, !Q) ∈ bangRel Rel" by(rule Rel.BRBang)
        with PRelQ have "(P ∥ !P, Q ∥ !Q) ∈ bangRel Rel" by(rule Rel.BRPar)
        hence "weakSimStepAct (P ∥ !P) Rs (P ∥ !P) (bangRel Rel')" by(rule IH)
        thus ?case
        proof(simp (no_asm) add: weakSimStepAct_def, auto)
          fix Q' a x
          assume "weakSimStepAct (P ∥ !P) (a<νx> ≺ Q') (P ∥ !P) (bangRel Rel')" and "x ♯ P"
          then obtain P' where PTrans: "(P ∥ !P) ⟹a<νx> ≺ P'"
                           and P'RelQ': "(P', Q') ∈ (bangRel Rel')"
            by(simp add: weakSimStepAct_def, blast)
          from PTrans have "!P ⟹a<νx> ≺ P'"
            by(force intro: Weak_Early_Step_Semantics.Bang simp add: weakTransition_def)
          with P'RelQ' show "∃P'. !P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ (bangRel Rel')" by blast
        next
          fix Q' α
          assume "weakSimStepAct (P ∥ !P) (α ≺ Q') (P ∥ !P) (bangRel Rel')"
          then obtain P' where PTrans: "(P ∥ !P) ⟹α ≺ P'"
                           and P'RelQ': "(P', Q') ∈ (bangRel Rel')"
            by(simp add: weakSimStepAct_def, blast)
          from PTrans have "!P ⟹α ≺ P'" by(rule Weak_Early_Step_Semantics.Bang)
          with P'RelQ' show "∃P'. !P ⟹α ≺ P' ∧ (P', Q') ∈ (bangRel Rel')" by blast
        qed
      qed
    qed
  qed
  moreover from PRelQ have "(!P, !Q) ∈ bangRel Rel" by(rule Rel.BRBang)
  ultimately show ?thesis by(simp add: simDef)
qed
*)
end

Theory Weak_Early_Sim_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Sim_Pres
  imports Weak_Early_Sim
begin

lemma tauPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "τ.(P) ↝<Rel> τ.(Q)"
proof(induct rule: simCases)
  case(Bound Q' a x)
  have "τ.(Q) ax>  Q'" by fact
  hence False by(induct rule: tauCases', auto)
  thus ?case by simp
next
  case(Free Q' α)
  have "τ.(Q) (α  Q')" by fact
  thus ?case
  proof(induct rule: tauCases', auto simp only: pi.inject residual.inject)
    have "τ.(P) ^ τ  P" by(rule Tau)
    with PRelQ show "P'. τ.(P) ^τ  P'  (P', Q)  Rel" by blast
  qed
qed

lemma inputPres:
  fixes P    :: pi
  and   x    :: name
  and   Q    :: pi
  and   a    :: name
  and   Rel  :: "(pi × pi) set"

  assumes PRelQ: "y. (P[x::=y], Q[x::=y])  Rel"
  and     Eqvt: "eqvt Rel"

  shows "a<x>.P ↝<Rel> a<x>.Q"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, a, P, Q)"])
  case(Bound b y Q')
  from y  (x, a, P, Q) have "y  x" "y  a" "y  P" "y  Q" by simp+
  from a<x>.Q by>  Q' y  a y  x y  Q show ?case
    by(erule_tac inputCases') auto
next
  case(Free α Q')
  from a<x>.Q  α  Q'
  show ?case
  proof(induct rule: inputCases)
    case(cInput u)
    have "a<x>.P ^(a<u>)  P[x::=u]"
      by(rule Input)
    moreover from PRelQ have "(P[x::=u], Q[x::=u])  Rel" by auto
    ultimately show ?case by blast
  qed
qed

lemma outputPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"

  assumes PRelQ: "(P, Q)  Rel"

  shows "a{b}.P ↝<Rel> a{b}.Q"
proof(induct rule: simCases)
  case(Bound Q' c x)
  have "a{b}.Q cx>  Q'" by fact
  hence False by(induct rule: outputCases', auto)
  thus ?case by simp
next
  case(Free Q' α)
  have "a{b}.Q α  Q'" by fact
  thus "P'. a{b}.P ^ α  P'  (P', Q')  Rel"
  proof(induct rule: outputCases', auto simp add: pi.inject residual.inject)
    have "a{b}.P ^ a[b]  P" by(rule Output)
    with PRelQ show "P'. a{b}.P ^ a[b]  P'  (P', Q)  Rel" by blast
  qed
qed

lemma matchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝<Rel> Q"
  and     RelRel': "Rel  Rel'"
  and     RelStay: "R S c. (R, S)  Rel  ([cc]R, S)  Rel"

  shows "[ab]P ↝<Rel'> [ab]Q"
proof(induct rule: simCases)
  case(Bound Q' c x)
  have "x  [ab]P" by fact
  hence xFreshP: "(x::name)  P" by simp
  have "[ab]Q cx>  Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case Match
    have "Q cx>  Q'" by fact
    with PSimQ xFreshP obtain P' where PTrans: "P cx>  P'"
                                   and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans have "[aa]P cx>  P'" by(rule Weak_Early_Step_Semantics.Match)
    moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by blast
    ultimately show ?case by blast
  qed
next
  case(Free Q' α)
  have "[ab]Q α  Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case Match
    have "Q  α  Q'" by fact
    with PSimQ obtain P' where "P ^α  P'" and "(P', Q')  Rel"
      by(blast dest: simE)
    thus ?case
    proof(induct rule: transitionCases)
      case Step
      have "P α  P'" by fact
      hence "[aa]P α  P'" by(rule Weak_Early_Step_Semantics.Match)
      with RelRel' (P', Q')  Rel show ?case by(force simp add: weakFreeTransition_def)
    next
      case Stay
      have "[aa]P ^τ  [aa]P" by(simp add: weakFreeTransition_def)
      moreover from (P, Q')  Rel have "([aa]P, Q')  Rel" by(blast intro: RelStay)
      ultimately show ?case using RelRel' by blast
    qed
  qed
qed

lemma mismatchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝<Rel> Q"
  and     RelRel': "Rel  Rel'"
  and     RelStay: "R S c d. (R, S)  Rel; c  d  ([cd]R, S)  Rel"

  shows "[ab]P ↝<Rel'> [ab]Q"
proof(induct rule: simCases)
  case(Bound Q' c x)
  have "x  [ab]P" by fact
  hence xFreshP: "(x::name)  P" by simp
  have "[ab]Q cx>  Q'" by fact
  thus ?case
  proof(induct rule: mismatchCases)
    case Mismatch
    have aineqb: "a  b" by fact
    have "Q cx>  Q'" by fact
    with PSimQ xFreshP obtain P' where PTrans: "P cx>  P'"
                                   and P'RelQ': "(P', Q')  Rel"
      by(blast dest: simE)
    from PTrans aineqb have "[ab]P cx>  P'" by(rule Weak_Early_Step_Semantics.Mismatch)
    moreover from P'RelQ' RelRel' have "(P', Q')  Rel'" by blast
    ultimately show ?case by blast
  qed
next
  case(Free Q' α)
  have "[ab]Q α  Q'" by fact
  thus ?case
  proof(induct rule: mismatchCases)
    case Mismatch
    have aineqb: "a  b" by fact
    have "Q  α  Q'" by fact
    with PSimQ obtain P' where "P ^α  P'" and "(P', Q')  Rel"
      by(blast dest: simE)
    thus ?case
    proof(induct rule: transitionCases)
      case Step
      have "P α  P'" by fact
      hence "[ab]P α  P'" using aineqb by(rule Weak_Early_Step_Semantics.Mismatch)
      with RelRel' (P', Q')  Rel show ?case by(force simp add: weakFreeTransition_def)
    next
      case Stay
      have "[ab]P ^τ  [ab]P" by(simp add: weakFreeTransition_def)
      moreover from (P, Q')  Rel aineqb have "([ab]P, Q')  Rel" by(blast intro: RelStay)
      ultimately show ?case using RelRel' by blast
    qed
  qed
qed

lemma parCompose:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   S     :: pi
  and   Rel   :: "(pi × pi) set"
  and   Rel'  :: "(pi × pi) set"
  and   Rel'' :: "(pi × pi) set"
  
  assumes PSimQ:    "P ↝<Rel> Q"
  and     RSimT:    "R ↝<Rel'> S"
  and     PRelQ:    "(P, Q)  Rel"
  and     RRel'T:   "(R, S)  Rel'"
  and     Par:      "P' Q' R' S'. (P', Q')  Rel; (R', S')  Rel'  (P'  R', Q'  S')  Rel''"
  and     Res:      "T U x. (T, U)  Rel''  (x>T, x>U)  Rel''"

  shows "P  R ↝<Rel''> Q  S"
proof -
  show ?thesis
  proof(induct rule: simCases)
    case(Bound Q' a x)
    have "x  P  R" by fact
    hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
    have "Q  S ax>  Q'" by fact
    thus ?case
    proof(induct rule: parCasesB)
      case(cPar1 Q')
      have QTrans: "Q  ax>  Q'" and xFreshT: "x  S" by fact+
      from xFreshP PSimQ QTrans obtain P' where PTrans:"P ax>  P'"
                                            and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans xFreshR have "P  R ax>  (P'  R)" by(rule Weak_Early_Step_Semantics.Par1B)
      moreover from P'RelQ' RRel'T have "(P'  R, Q'  S)  Rel''" by(rule Par)
      ultimately show ?case by blast
    next
      case(cPar2 S')
      have STrans: "S  ax>  S'" and xFreshQ: "x  Q" by fact+
      from xFreshR RSimT STrans obtain R' where RTrans:"R ax>  R'"
                                            and R'Rel'T': "(R', S')   Rel'"
        by(blast dest: simE)
      from RTrans xFreshP xFreshR have ParTrans: "P  R ax>  (P  R')"
        by(blast intro: Weak_Early_Step_Semantics.Par2B)
      moreover from PRelQ R'Rel'T' have "(P  R', Q   S')  Rel''" by(rule Par)
      ultimately show ?case by blast
    qed
  next
    case(Free QT' α)
    have "Q  S  α  QT'" by fact
    thus ?case
    proof(induct rule: parCasesF[of _ _ _ _ _ "(P, R)"])
      case(cPar1 Q')
      have "Q  α  Q'" by fact
      with PSimQ obtain P' where PTrans: "P ^ α  P'" and PRel: "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans have Trans: "P  R ^ α  P'  R" by(rule Weak_Early_Semantics.Par1F)
      moreover from PRel RRel'T have "(P'  R, Q'  S)  Rel''" by(blast intro: Par)
      ultimately show ?case by blast
    next
      case(cPar2 S')
      have "S  α  S'" by fact
      with RSimT obtain R' where RTrans: "R ^ α  R'" and RRel: "(R', S')  Rel'"
        by(blast dest: simE)
      from RTrans have Trans: "P  R ^ α  P  R'" by(rule Weak_Early_Semantics.Par2F)
      moreover from PRelQ RRel have "(P  R', Q  S')  Rel''" by(blast intro: Par)
      ultimately show ?case by blast
    next
      case(cComm1 Q' S' a b)
      have QTrans: "Q  a<b>  Q'" and STrans: "S  a[b]  S'" by fact+

      from PSimQ QTrans obtain P' where PTrans: "P a<b>  P'"
                                    and P'RelQ': "(P', Q')  Rel"
        by(fastforce dest: simE simp add: weakFreeTransition_def)
      
      from RSimT STrans obtain R' where RTrans: "R a[b]  R'"
                                    and RRel: "(R', S')  Rel'"
        by(fastforce dest: simE simp add: weakFreeTransition_def)
      
      from PTrans RTrans have "P  R τ  P'  R'" by(rule Weak_Early_Step_Semantics.Comm1)
      hence "P  R ^τ  P'  R'" 
        by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)

      moreover from P'RelQ' RRel have "(P'  R', Q'  S')  Rel''" by(rule Par)
      ultimately show ?case by blast
    next
      case(cComm2 Q' S' a b)
      have QTrans: "Q a[b]  Q'" and STrans: "S a<b>  S'" by fact+
      
      from PSimQ QTrans obtain P' where PTrans: "P a[b]  P'"
                                    and PRel: "(P', Q')  Rel"
        by(fastforce dest: simE simp add: weakFreeTransition_def)
      
      from RSimT STrans obtain R' where RTrans: "R a<b>  R'"
                                   and R'Rel'T': "(R', S')  Rel'"
        by(fastforce dest: simE simp add: weakFreeTransition_def)
      
      from PTrans RTrans have "P  R τ  P'  R'" by(rule Weak_Early_Step_Semantics.Comm2)
      hence "P  R ^τ  P'  R'" 
        by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)
      moreover from PRel R'Rel'T' have "(P'  R', Q'  S')  Rel''" by(rule Par)
      ultimately show ?case by blast
    next
      case(cClose1 Q' S' a x)
      have QTrans: "Q a<x>  Q'" and STrans: "S ax>  S'" by fact+
      have "x  (P, R)" by fact
      hence xFreshP: "x  P" and xFreshR: "x  R" by(simp add: fresh_prod)+
      
      from PSimQ QTrans obtain P' where PTrans: "P a<x>  P'"
                                    and P'RelQ': "(P', Q')  Rel"
        by(fastforce dest: simE simp add: weakFreeTransition_def)
      
      from RSimT STrans xFreshR obtain R' where RTrans: "R ax>  R'" 
                                            and R'Rel'T': "(R', S')  Rel'"
        by(blast dest: simE)
       
      from PTrans RTrans xFreshP have Trans: "P  R τ  x>(P'  R')"
        by(rule Weak_Early_Step_Semantics.Close1)
      hence "P  R ^τ  x>(P'  R')" 
        by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)
      moreover from P'RelQ' R'Rel'T' have "(x>(P'  R'), x>(Q'  S'))  Rel''"
        by(blast intro: Par Res)
      ultimately show ?case by blast
    next
      case(cClose2 Q' S' a x)
      have QTrans: "Q ax>  Q'" and STrans: "S a<x>  S'" by fact+
      have "x  (P, R)" by fact
      hence xFreshR: "x  R" and xFreshP: "x  P" by(simp add: fresh_prod)+

      from PSimQ QTrans xFreshP obtain P' where PTrans: "P ax>  P'"
                                            and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      
      from RSimT STrans obtain R' where RTrans: "R a<x>  R'"
                                    and R'Rel'T': "(R', S')  Rel'"
        by(fastforce dest: simE simp add: weakFreeTransition_def)
      from PTrans RTrans xFreshR have Trans: "P  R τ  x>(P'  R')"
        by(rule Weak_Early_Step_Semantics.Close2)
      hence "P  R ^τ  x>(P'  R')" 
        by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)
      moreover from P'RelQ' R'Rel'T' have "(x>(P'  R'), x>(Q'  S'))  Rel''"
        by(blast intro: Par Res)
      ultimately show ?case by blast
    qed
  qed
qed

lemma parPres:
  fixes P   :: pi
  and   Q   :: pi
  and   R   :: pi
  and   a   :: name
  and   Rel :: "(pi × pi) set"
  and   Rel' :: "(pi × pi) set"
  
  assumes PSimQ:    "P ↝<Rel> Q"
  and     PRelQ:    "(P, Q)  Rel"
  and     Par:      "S T U. (S, T)  Rel  (S  U, T  U)  Rel'"
  and     Res:      "S T x. (S, T)  Rel'  (x>S, x>T)  Rel'"

  shows "P  R ↝<Rel'> Q  R"
proof -
  note PSimQ 
  moreover have RSimR: "R ↝<Id> R" by(auto intro: reflexive)
  moreover note PRelQ moreover have "(R, R)  Id" by auto
  moreover from Par have "P Q R T. (P, Q)  Rel; (R, T)  Id  (P  R, Q  T)  Rel'"
    by auto
  ultimately show ?thesis using Res by(rule parCompose)
qed

lemma resPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   x    :: name
  and   Rel' :: "(pi × pi) set"

  assumes PSimQ: "P ↝<Rel> Q"
  and     ResRel: "R S y. (R, S)  Rel  (y>R, y>S)  Rel'"
  and     RelRel': "Rel  Rel'"
  and     EqvtRel: "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "x>P ↝<Rel'> x>Q"
proof -
  from EqvtRel' show ?thesis
  proof(induct rule: simCasesCont[where C="(P, x)"])
    case(Bound a y Q')
    have Trans: "x>Q ay>  Q'" by fact
    have "y  (P, x)" by fact
    hence yineqx: "y  x" and yFreshP: "y  P" by(simp add: fresh_prod)+
    from Trans yineqx show ?case
    proof(induct rule: resCasesB)
      case(Open Q')
      have QTrans: "Q a[x]  Q'" and aineqx: "a  x" by fact+

      from PSimQ QTrans obtain P' where PTrans: "P ^a[x]  P'"
                                    and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      
      from PTrans aineqx have "x>P ax>  P'" 
        by(force intro: Weak_Early_Step_Semantics.Open simp add: weakFreeTransition_def)
      with y  P y  x have "x>P ay>  ([(y, x)]  P')"
        by(force intro: weakTransitionAlpha simp add: abs_fresh name_swap)
      moreover from EqvtRel P'RelQ' RelRel' have "([(y, x)]  P', [(y, x)]  Q')  Rel'"
        by(blast intro: eqvtRelI)
      ultimately show ?case by blast
    next
      case(Res Q')
      have QTrans: "Q ay>  Q'" and xineqa: "x  a" by fact+

      from PSimQ yFreshP QTrans obtain P' where PTrans: "P ay>  P'"
                                            and P'RelQ': "(P', Q')  Rel"
        by(blast dest: simE)
      from PTrans xineqa yineqx yFreshP have ResTrans: "x>P ay>  (x>P')"
        by(blast intro: Weak_Early_Step_Semantics.ResB)
      moreover from P'RelQ' have "((x>P'), (x>Q'))  Rel'"
        by(rule ResRel)
      ultimately show ?case by blast
    qed
  next
    case(Free α Q')
    have QTrans: "x>Q  α  Q'" by fact
    have "c::name. c  (P, Q, Q', α)" by(blast intro: name_exists_fresh)
    then obtain c::name where cFreshQ: "c  Q" and cFreshAlpha: "c  α" and cFreshQ': "c  Q'" and cFreshP: "c  P"
      by(force simp add: fresh_prod)
    from cFreshP have "x>P = c>([(x, c)]  P)" by(simp add: alphaRes)
    moreover have "P'.c>([(x, c)]  P) ^ α  P'  (P', Q')  Rel'"
    proof -
      from QTrans cFreshQ have "c>([(x, c)]  Q) α  Q'" by(simp add: alphaRes)
      moreover have "c  α" by(rule cFreshAlpha)
      moreover from PSimQ EqvtRel have "([(x, c)]  P) ↝<Rel> ([(x, c)]  Q)"
        by(blast intro: eqvtI)
      ultimately show ?thesis
        apply(induct rule: resCasesF, auto simp add: residual.inject pi.inject name_abs_eq)
        by(blast intro: ResF ResRel dest: simE)
    qed

    ultimately show ?case by force
  qed
qed

lemma resChainI:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"
  and   lst :: "name list"

  assumes eqvtRel: "eqvt Rel"
  and     Res:     "R S y. (R, S)  Rel  (y>R, y>S)  Rel"
  and     PRelQ:   "P ↝<Rel> Q"

  shows "(resChain lst) P ↝<Rel> (resChain lst) Q"
proof -
  show ?thesis
  proof(induct lst) (* Base case *)
    from PRelQ show "resChain [] P ↝<Rel> resChain [] Q" by simp
  next (* Inductive step *)
    fix a lst
    assume IH: "(resChain lst P) ↝<Rel> (resChain lst Q)"
    moreover from Res have "P Q a. (P, Q)  Rel  (a>P, a>Q)  Rel"
      by simp
    moreover have "Rel  Rel" by simp
    ultimately have "a>(resChain lst P) ↝<Rel> a>(resChain lst Q)" using eqvtRel
      by(rule_tac resPres)
    thus "resChain (a # lst) P ↝<Rel> resChain (a # lst) Q"
      by simp
  qed
qed

lemma bangPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
 
  assumes PRelQ:       "(P, Q)  Rel"
  and     Sim:         "R S. (R, S)  Rel  R ↝<Rel> S"

  and     ParComp:     "R S T U. (R, S)  Rel; (T, U)  Rel'  (R  T, S  U)  Rel'"
  and     Res:         "R S x. (R, S)  Rel'  (x>R, x>S)  Rel'"

  and     RelStay:        "R S. (R  !R, S)  Rel'  (!R, S)  Rel'"
  and     BangRelRel': "(bangRel Rel)  Rel'"
  and     eqvtRel':    "eqvt Rel'"

  shows "!P ↝<Rel'> !Q"
proof -
  let ?Sim = "λP Rs. (a x Q'. Rs = ax>  Q'  x  P  (P'. P ax>  P'  (P', Q')  Rel')) 
                     (α Q'. Rs = α  Q'  (P'. P ^α  P'  (P', Q')  Rel'))"
  {
    fix Rs P
    assume "!Q  Rs" and "(P, !Q)  bangRel Rel"
    hence "?Sim P Rs" using PRelQ
    proof(nominal_induct avoiding: P rule: bangInduct)
      case(Par1B a x Q')
      have QTrans: "Q ax>  Q'" and xFreshQ: "x  Q" by fact+
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelT: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        from PRelQ have PSimQ: "P ↝<Rel> Q" by(rule Sim)
        from x  P x  Q show ?case
        proof(auto simp add: residual.inject alpha' name_fresh_fresh)
          from PSimQ QTrans xFreshP obtain P' where PTrans: "P ax>  P'"
                                                and P'RelQ': "(P', Q')  Rel"
            by(blast dest: simE)
          from PTrans xFreshR have "P  R ax> (P'  R)"
            by(rule Weak_Early_Step_Semantics.Par1B)
          moreover from P'RelQ' RBangRelT BangRelRel' have "(P'  R, Q'  !Q)  Rel'"
            by(blast intro: Rel.BRPar)
          ultimately show "P'. P  R ax>  P'  (P', Q'  !Q)  Rel'" by blast
        next
          fix y
          assume "(y::name)  Q'" and "y  P" and "y  R"
          from QTrans y  Q' have "Q ay>  ([(x, y)]  Q')" by(simp add: alphaBoundOutput)
          with PSimQ y  P obtain P' where PTrans: "P ay>  P'"
                                         and P'RelQ': "(P', [(x, y)]  Q')  Rel"
            by(blast dest: simE)
          from PTrans y  R have "P  R ay> (P'  R)" by(rule Weak_Early_Step_Semantics.Par1B)
          moreover from P'RelQ' RBangRelT BangRelRel' have "(P'  R, ([(y, x)]  Q')  !Q)  Rel'"
            by(fastforce intro: Rel.BRPar simp add: name_swap) 
          ultimately show "P'. P  R ay>  P'  (P', ([(y, x)]  Q')  !Q)  Rel'" by blast
        qed
      qed
    next
      case(Par1F α Q' P)
      have QTrans: "Q α  Q'" by fact
      have "(P, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝<Rel> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P ^α  P'" and P'RelQ': "(P', Q')  Rel"
            by(blast dest: simE)

          from PTrans have "P  R ^α  P'  R" by(rule Weak_Early_Semantics.Par1F)
          moreover from P'RelQ' RBangRelQ have "(P'  R, Q'  !Q)  bangRel Rel"
            by(rule Rel.BRPar)
          ultimately show "P'. P  R ^α  P'  (P', Q'  !Q)  Rel'" using BangRelRel' by blast
        qed
      qed
    next
      case(Par2B a x Q' P)
      hence IH: "P. (P, !Q)  bangRel Rel  ?Sim P (ax>  Q')" by simp
      have xFreshQ: "x  Q" by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        show ?case using x  Q
        proof(auto simp add: residual.inject alpha' name_fresh_fresh)
          from IH RBangRelQ have "?Sim R (ax>  Q')" by blast
          with xFreshR obtain R' where RTrans: "R ax>  R'" and R'BangRelQ': "(R', Q')  Rel'"
            by(blast dest: simE)
          from RTrans xFreshP have "P  R ax>  (P  R')"
            by(auto intro: Weak_Early_Step_Semantics.Par2B)
          moreover from PRelQ R'BangRelQ' have "(P  R', Q  Q')  Rel'"
            by(rule ParComp)
          ultimately show "P'. P  R ax>  P'  (P', Q  Q')  Rel'" by blast
        next
          fix y
          assume "(y::name)  Q'" and "y  R" and "y  P"
          from IH RBangRelQ have "?Sim R (ax>  Q')" by blast
          with y  Q' have  "?Sim R (ay>  ([(x, y)]  Q'))" by(simp add: alphaBoundOutput)
          with y  Robtain R' where RTrans: "R ay>  R'" and R'BangRelQ': "(R', [(x, y)]  Q')  Rel'"
            by(blast dest: simE)
          from RTrans y  P have "P  R ay>  (P  R')"
            by(auto intro: Weak_Early_Step_Semantics.Par2B)
          moreover from PRelQ R'BangRelQ' have "(P  R', Q  ([(y, x)]  Q'))  Rel'"
            by(fastforce intro: ParComp simp add: name_swap)
          ultimately show "P'. P  R ay>  P'  (P', Q  ([(y, x)]  Q'))  Rel'" by blast
        qed
      qed
    next
      case(Par2F α Q' P)
      hence IH: "P. (P, !Q)  bangRel Rel  ?Sim P (α  Q')" by simp
      have "(P, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from RBangRelQ have "?Sim R (α  Q')" by(rule IH)
          then obtain R' where RTrans: "R ^α  R'" and R'RelQ': "(R', Q')  Rel'"
            by(blast dest: simE)
          from RTrans have "P  R ^α  P  R'" by(rule Weak_Early_Semantics.Par2F)
          moreover from PRelQ R'RelQ' have "(P  R', Q  Q')  Rel'" by(rule ParComp)
          ultimately show "P'. P  R ^α  P'  (P', Q  Q')  Rel'" by blast
        qed
      qed
    next
      case(Comm1 a Q' b Q'' P)
      hence IH: "P. (P, !Q)  bangRel Rel  ?Sim P (a[b]  Q'')" by simp
      have QTrans: "Q  a<b>  Q'" by fact
      have "(P, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝<Rel> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P a<b>  P'" and P'RelQ': "(P', Q')  Rel"
            by(fastforce dest: simE simp add: weakFreeTransition_def)

          from RBangRelQ have "?Sim R (a[b]  Q'')" by(rule IH)
          then obtain R' where RTrans: "R a[b]  R'"
                           and R'RelQ'': "(R', Q'')  Rel'"
            by(fastforce dest: simE simp add: weakFreeTransition_def)
          from PTrans RTrans have "P  R τ  (P'  R')"
            by(rule Weak_Early_Step_Semantics.Comm1)
          hence "P  R τ P'  R'" 
            by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)
          moreover from P'RelQ' R'RelQ'' have "(P'  R', Q'  Q'')  Rel'"
            by(rule ParComp)
          ultimately show "P'. (P  R, P')  {(P, P'). P  τ  P'}*  (P', Q'  Q'')  Rel'"
            by auto
        qed
      qed
    next
      case(Comm2 a b Q' Q'' P)
      hence IH: "P. (P, !Q)  bangRel Rel  ?Sim P (a<b>  Q'')" by simp
      have QTrans: "Q a[b]  Q'" by fact
      have "(P, Q  !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝<Rel> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P a[b]  P'" and P'RelQ': "(P', Q')  Rel"
            by(fastforce dest: simE simp add: weakFreeTransition_def)

          from RBangRelQ have "?Sim R (a<b>  Q'')" by(rule IH)
          then obtain R' where RTrans: "R a<b>  R'" and R'BangRelQ'': "(R', Q'')  Rel'"
            by(fastforce dest: simE simp add: weakFreeTransition_def)
        
          from PTrans RTrans have "P  R τ  (P'  R')"
            by(rule Weak_Early_Step_Semantics.Comm2)
          hence "P  R τ P'  R'" 
            by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)
          moreover from P'RelQ' R'BangRelQ'' have "(P'  R', Q'  Q'')  Rel'"
            by(rule ParComp)
          ultimately show "P'. (P  R, P')  {(P, P'). P  τ  P'}*  (P', Q'  Q'')  Rel'" by auto
        qed
      qed
    next
      case(Close1 a x Q' Q'' P)
      hence IH: "P. (P, !Q)  bangRel Rel  ?Sim P (ax>  Q'')" by simp
      have QTrans: "Q  a<x>  Q'" by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshR: "x  R" and xFreshP: "x  P" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝<Rel> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P a<x>  P'" and P'RelQ': "(P', Q')  Rel"
            by(fastforce dest: simE simp add: weakFreeTransition_def)
          
          from RBangRelQ have "?Sim R (ax>  Q'') " by(rule IH)
          with xFreshR obtain R' where RTrans: "R ax>  R'"
                                   and R'RelQ'': "(R', Q'')  Rel'"
            by(blast dest: simE)
        
          from PTrans RTrans xFreshP have "P  R τ  x>(P'  R')"
            by(rule Weak_Early_Step_Semantics.Close1)
          moreover from P'RelQ' R'RelQ'' have "(x>(P'  R'), x>(Q'  Q''))  Rel'"
            by(force intro: ParComp Res)
          ultimately show "P'. (P  R, P')  {(P, P'). P  τ  P'}*  (P', x>(Q'  Q''))  Rel'" by auto
        qed
      qed
    next
      case(Close2 a x Q' Q'' P)
      hence IH: "P. (P, !Q)  bangRel Rel  ?Sim P (a<x>  Q'')" by simp
      have QTrans: "Q  ax>  Q'" by fact
      have "(P, Q  !Q)  bangRel Rel" and "x  P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q)  Rel" and RBangRelQ: "(R, !Q)  bangRel Rel" by fact+
        have "x  P  R" by fact
        hence xFreshP: "x  P" and xFreshR: "x  R" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P ↝<Rel> Q" by(rule Sim)
          with QTrans xFreshP obtain P' where PTrans: "P ax>  P'"
                                          and P'RelQ': "(P', Q')  Rel"
            by(blast dest: simE)

          from RBangRelQ have "?Sim R (a<x>  Q'')" by(rule IH)
          with xFreshR obtain R' where RTrans: "R a<x>  R'"
                                       and R'RelQ'': "(R', Q'')  Rel'"
            by(fastforce simp add: weakFreeTransition_def)
          from PTrans RTrans xFreshR have "P  R τ  x>(P'  R')"
            by(rule Weak_Early_Step_Semantics.Close2)
          moreover from P'RelQ' R'RelQ'' have "(x>(P'  R'), x>(Q'  Q''))  Rel'"
            by(force intro: ParComp Res)
          ultimately show "P'. (P  R, P')  {(P, P'). P  τ  P'}*  (P', x>(Q'  Q''))  Rel'" by auto
        qed
      qed
    next
      case(Bang Rs)
      hence IH: "P. (P, Q  !Q)  bangRel Rel  ?Sim P Rs" by simp
      have "(P, !Q)  bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRBangCases)
        case(BRBang P)
        have PRelQ: "(P, Q)  Rel" by fact
        hence "(!P, !Q)  bangRel Rel" by(rule Rel.BRBang)
        with PRelQ have "(P  !P, Q  !Q)  bangRel Rel" by(rule Rel.BRPar)
        hence IH: "?Sim (P  !P) Rs" by(rule IH)
        show ?case
        proof(intro conjI allI impI)
          fix Q' a x
          assume "Rs = ax>  Q'" and "x  !P"
          then obtain P' where PTrans: "(P  !P) ax>  P'"
                           and P'RelQ': "(P', Q')  Rel'" using IH
            by(auto simp add: residual.inject)
          from PTrans have "!P ax>  P'"
            by(force intro: Weak_Early_Step_Semantics.Bang simp add: weakFreeTransition_def)
          with P'RelQ' show "P'. !P ax>  P'  (P', Q')  Rel'" by blast
        next
          fix Q' α
          assume "Rs = α  Q'"
          then obtain P' where PTrans: "(P  !P) ^α  P'"
                           and P'RelQ': "(P', Q')  Rel'" using IH
            by auto
          from PTrans show "P'. !P ^α  P'  (P', Q')  Rel'" using P'RelQ'
          proof(induct rule: transitionCases)
            case Step
            have "P  !P α  P'" by fact
            hence "!P α  P'" by(rule Weak_Early_Step_Semantics.Bang)
            with P'RelQ' show ?case by(force simp add: weakFreeTransition_def)
          next
            case Stay
            have "!P ^τ  !P" by(simp add: weakFreeTransition_def)
            moreover assume "(P  !P, Q')  Rel'"
            hence "(!P, Q')  Rel'" by(blast intro: RelStay)
            ultimately show ?case by blast
          qed
        qed
      qed
    qed
  }
  moreover from PRelQ have "(!P, !Q)  bangRel Rel" by(rule Rel.BRBang)
  ultimately show ?thesis by(auto simp add: weakSimulation_def)
qed

lemma bangRelSim:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi × pi) set"
  and   Rel'l :: "(pi × pi) set"

  assumes PBangRelQ: "(P, Q)  bangRel Rel"
  and     Sim:       "R S. (R, S)  Rel  R ↝<Rel> S"

  and     ParComp:     "R S T U. (R, S)  Rel; (T, U)  Rel'  (R  T, S  U)  Rel'"
  and     Res:         "R S x. (R, S)  Rel'  (x>R, x>S)  Rel'"

  and     RelStay:        "R S. (R  !R, S)  Rel'  (!R, S)  Rel'"
  and     BangRelRel': "(bangRel Rel)  Rel'"
  and     eqvtRel':    "eqvt Rel'"
  and     Eqvt: "eqvt Rel"

  shows "P ↝<Rel'> Q"
proof -
  from PBangRelQ show ?thesis
  proof(induct rule: bangRel.induct)
    case(BRBang P Q)
    have PRelQ: "(P, Q)  Rel" by fact
    thus ?case using ParComp Res BangRelRel' eqvtRel' Eqvt RelStay Sim
      by(rule_tac bangPres)
  next
    case(BRPar P Q R T) 
    have "(P, Q)  Rel" by fact
    moreover hence "P ↝<Rel> Q" by(rule Sim)
    moreover have "R ↝<Rel'> T" by fact
    moreover have "(R, T)  bangRel Rel" by fact
    ultimately show ?case using ParComp eqvtRel' Res Eqvt BangRelRel'
      by(blast intro: parCompose)
  next
    case(BRRes P Q x)
    have "P ↝<Rel'> Q" by fact
    thus ?case using BangRelRel' eqvtRel' Res by(blast intro: resPres)
  qed
qed

end

Theory Strong_Early_Late_Comp

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Early_Late_Comp
  imports Strong_Late_Bisim_Subst_SC Strong_Early_Bisim_Subst
begin

abbreviation TransitionsLate_judge ("_ l _" [80, 80] 80) where "P l Rs  transitions P Rs"
abbreviation TransitionsEarly_judge ("_ e _" [80, 80] 80) where "P e Rs  TransitionsEarly P Rs"

abbreviation Transitions_InputjudgeLate ("_<_> l _" [80, 80] 80) where "a<x> l P'  (Late_Semantics.BoundR (Late_Semantics.InputS a) x P')"
abbreviation Transitions_OutputjudgeLate ("_[_] l _" [80, 80] 80) where "a[b] l P'  (Late_Semantics.FreeR (Late_Semantics.OutputR a b) P')"
abbreviation Transitions_BoundOutputjudgeLate ("__> l _" [80, 80] 80) where "ax> l P'  (Late_Semantics.BoundR (Late_Semantics.BoundOutputS a) x P')"
abbreviation Transitions_TaujudgeLate ("τ l _" 80) where "τ l P'  (Late_Semantics.FreeR Late_Semantics.TauR P')"

abbreviation Transitions_InputjudgeEarly ("_<_> e _" [80, 80] 80) where "a<x> e P'  (Early_Semantics.FreeR (Early_Semantics.InputR a x) P')"
abbreviation Transitions_OutputjudgeEarly ("_[_] e _" [80, 80] 80) where "a[b] e P'  (Early_Semantics.FreeR (Early_Semantics.OutputR a b) P')"
abbreviation Transitions_BoundOutputjudgeEarly ("__> e _" [80, 80] 80) where "ax> e P' (Early_Semantics.BoundOutputR a x P')"
abbreviation Transitions_TaujudgeEarly ("τ e _" 80) where "τ e P'  (Early_Semantics.FreeR Early_Semantics.TauR P')"

lemma earlyLateOutput:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes "P ea[b] e P'"

  shows "P la[b] l P'"
using assms
proof(nominal_induct rule: Early_Semantics.outputInduct)
  case(Output a b P)
  show ?case by(rule Late_Semantics.Output)
next
  case(Match P a b P' c)
  have "P la[b] l P'" by fact
  thus ?case by(rule Late_Semantics.Match)
next
  case(Mismatch P a b P' c d)
  from P la[b] l P' c  d
  show ?case by(rule Late_Semantics.Mismatch)
next
  case(Sum1 P a b P' Q)
  have "P la[b] l P'" by fact
  thus ?case by(rule Late_Semantics.Sum1)
next
  case(Sum2 Q a b Q' P)
  have "Q la[b] l Q'" by fact
  thus ?case by(rule Late_Semantics.Sum2)
next
  case(Par1 P a b P' Q)
  have "P la[b] l P'" by fact
  thus ?case by(rule Late_Semantics.Par1F)
next
  case(Par2 Q a b Q' P)
  have "Q la[b] l Q'" by fact
  thus ?case by(rule Late_Semantics.Par2F)
next
  case(Res P a b P' x)
  have "P la[b] l P'" and "x  a" and "x  b" by fact+
  thus ?case by(force intro: Late_Semantics.ResF)
next
  case(Bang P a b P')
  have "P  !P la[b] l P'" by fact
  thus ?case by(rule Late_Semantics.Bang)
qed

lemma lateEarlyOutput:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes "P la[b] l P'"

  shows "P ea[b] e P'"
using assms
proof(nominal_induct rule: Late_Semantics.outputInduct)
  case(Output a b P)
  thus ?case by(rule Early_Semantics.Output)
next
  case(Match P a b P' c)
  have "P ea[b] e P'" by fact
  thus ?case by(rule Early_Semantics.Match)
next
  case(Mismatch P a b P' c d)
  have "P ea[b] e P'" and "c  d" by fact+
  thus ?case by(rule Early_Semantics.Mismatch)
next
  case(Sum1 P a b P' Q)
  have "P ea[b] e P'" by fact
  thus ?case by(rule Early_Semantics.Sum1)
next
  case(Sum2 Q a b Q' P)
  have "Q ea[b] e Q'" by fact
  thus ?case by(rule Early_Semantics.Sum2)
next
  case(Par1 P a b P' Q)
  have "P ea[b] e P'" by fact
  thus ?case by(rule Early_Semantics.Par1F)
next
  case(Par2 Q a b Q' P)
  have "Q ea[b] e Q'" by fact
  thus ?case by(rule Early_Semantics.Par2F)
next
  case(Res P a b P' x)
  have "P ea[b] e P'" and "x  a" and "x  b" by fact+
  thus ?case by(force intro: Early_Semantics.ResF)
next
  case(Bang P a b P')
  have "P  !P ea[b] e P'" by fact
  thus ?case by(rule Early_Semantics.Bang)
qed

lemma outputEq:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  shows "P ea[b] e P' = P la[b] l P'"
by(auto intro: lateEarlyOutput earlyLateOutput)

lemma lateEarlyBoundOutput:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi

  assumes "P lax> l P'"

  shows "P eax> e P'"
proof -
  have Goal: "P a x P'. P lax> l P'; x  P  P eax> e P'"
  proof -
    fix P a x P'
    assume "P l ax> l P'" and "x  P"
    thus "P eax> e P'"
    proof(nominal_induct rule: Late_Semantics.boundOutputInduct)
      case(Match P a x P' b)
      have "P e ax> e P'" by fact
      thus ?case by(rule Early_Semantics.Match)
    next
      case(Mismatch P a x P' b c)
      have "P e ax> e P'" and "b  c" by fact+
      thus ?case by(rule Early_Semantics.Mismatch)
    next
      case(Open P a x P')
      have "P la[x] l P'" by fact
      hence "P ea[x] e P'" by(rule lateEarlyOutput)
      moreover have "a  x" by fact
      ultimately show ?case by(rule Early_Semantics.Open)
    next
      case(Sum1 P Q a x P')
      have "P e ax> e P'" by fact
      thus ?case by(rule Early_Semantics.Sum1)
    next
      case(Sum2 P Q a x Q')
      have "Q e ax> e Q'" by fact
      thus ?case by(rule Early_Semantics.Sum2)
    next
      case(Par1 P P' Q a x)
      have "P e ax> e P'" and "x  Q" by fact+
      thus ?case by(rule Early_Semantics.Par1B)
    next
      case(Par2 P Q Q' a x)
      have "Q e ax> e Q'" and "x  P" by fact+
      thus ?case by(rule Early_Semantics.Par2B)
    next
      case(Res P P' a x y)
      have "P e ax> e P'" and "y  a" and "y  x" by fact+
      thus ?case by(force intro: Early_Semantics.ResB)
    next
      case(Bang P a x P')
      have "P  !P e ax> e P'" by fact
      thus ?case by(rule Early_Semantics.Bang)
    qed
  qed

  have "c::name. c  (P, P', x)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshP': "c  P'" and "c  x"
    by(force simp add: fresh_prod)
  from assms cFreshP' have "P lac> l ([(x, c)]  P')"
    by(simp add: Late_Semantics.alphaBoundResidual)
  hence "P e ac> e ([(x, c)]  P')" using cFreshP
    by(rule Goal)
  moreover from cFreshP' c  x have "x  [(x, c)]  P'" by(simp add: name_fresh_left name_calc)
  ultimately show ?thesis by(simp add: Early_Semantics.alphaBoundOutput name_swap)
qed

lemma earlyLateBoundOutput:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi

  assumes "P eax> e P'"

  shows "P lax> l P'"
proof -
  have Goal: "P a x P'. P eax> e P'; x  P  P lax> l P'"
  proof -
    fix P a x P'
    assume "P e ax>  P'" and "x  P"
    thus "P lax> l P'"
    proof(nominal_induct rule: Early_Semantics.boundOutputInduct)
      case(Match P a x P' b)
      have "P l ax>  P'" by fact
      thus ?case by(rule Late_Semantics.Match)
    next
      case(Mismatch P a x P' b c)
      have "P l ax>  P'" and "b  c" by fact+
      thus ?case by(rule Late_Semantics.Mismatch)
    next
      case(Open P a x P')
      have "P ea[x] e P'" by fact
      hence "P la[x] l P'" by(rule earlyLateOutput)
      moreover have "a  x" by fact
      ultimately show ?case by(rule Late_Semantics.Open)
    next
      case(Sum1 P Q a x P')
      have "P l ax> l P'" by fact
      thus ?case by(rule Late_Semantics.Sum1)
    next
      case(Sum2 P Q a x Q')
      have "Q l ax> l Q'" by fact
      thus ?case by(rule Late_Semantics.Sum2)
    next
      case(Par1 P P' Q a x)
      have "P l ax> l P'" and "x  Q" by fact+
      thus ?case by(rule Late_Semantics.Par1B)
    next
      case(Par2 P Q Q' a x)
      have "Q l ax> l Q'" and "x  P" by fact+
      thus ?case by(rule Late_Semantics.Par2B)
    next
      case(Res P P' a x y)
      have "P l ax> l P'" and "y  a" and "y  x" by fact+
      thus ?case by(force intro: Late_Semantics.ResB)
    next
      case(Bang P a x P')
      have "P  !P l ax>  P'" by fact
      thus ?case by(rule Late_Semantics.Bang)
    qed
  qed

  have "c::name. c  (P, P', x)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshP': "c  P'" and "c  x"
    by(force simp add: fresh_prod)
  from assms cFreshP' have "P eac> e ([(x, c)]  P')"
    by(simp add: Early_Semantics.alphaBoundOutput)
  hence "P l ac> l ([(x, c)]  P')" using cFreshP
    by(rule Goal)
  moreover from cFreshP' c  x have "x  [(x, c)]  P'" by(simp add: name_fresh_left name_calc)
  ultimately show ?thesis by(simp add: Late_Semantics.alphaBoundResidual name_swap)
qed

lemma BoundOutputEq:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi

  shows "P eax> e P' = P lax> l P'"
by(auto intro: earlyLateBoundOutput lateEarlyBoundOutput)

lemma lateEarlyInput:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   u  :: name

  assumes PTrans: "P l a<x> l P'"

  shows "P ea<u> e (P'[x::=u])"
proof -
  have Goal: "P a x P' u. P l a<x> l P'; x  P  P e a<u> e (P'[x::=u])"
  proof -
    fix P a x P' u
    assume "P l a<x> l P'" and "x  P"
    thus "P e a<u> e (P'[x::=u])"
    proof(nominal_induct avoiding: u rule: Late_Semantics.inputInduct)
      case(Input a x P)
      thus ?case by(rule Early_Semantics.Input)
    next
      case(Match P a x P' b u)
      have "P ea<u> e (P'[x::=u])" by fact
      thus ?case by(rule Early_Semantics.Match)
    next
      case(Mismatch P a x P' b c u)
      have "P ea<u> e (P'[x::=u])" by fact
      moreover have "bc" by fact
      ultimately show ?case by(rule Early_Semantics.Mismatch)
    next
      case(Sum1 P Q a x P')
      have "P ea<u> e (P'[x::=u])" by fact
      thus ?case by(rule Early_Semantics.Sum1)
    next
      case(Sum2 P Q a x Q')
      have "Q ea<u> e (Q'[x::=u])" by fact
      thus ?case by(rule Early_Semantics.Sum2)
    next
      case(Par1 P P' Q a x)
      have "P ea<u> e (P'[x::=u])" by fact
      hence "P  Q ea<u> e (P'[x::=u]  Q)" by(rule Early_Semantics.Par1F)
      moreover have "x  Q" by fact
      ultimately show ?case by(simp add: forget)
    next
      case(Par2 P Q Q' a x)
      have "Q ea<u> e (Q'[x::=u])" by fact
      hence "P  Q ea<u> e (P  Q'[x::=u])" by(rule Early_Semantics.Par2F)
      moreover have "x  P" by fact
      ultimately show ?case by(simp add: forget)
    next
      case(Res P P' a x y u)
      have "P ea<u> e (P'[x::=u])" and "y  a" and yinequ: "y  u" by fact+
      hence "y>P ea<u> e y>(P'[x::=u])" by(force intro: Early_Semantics.ResF)
      moreover have "y  x" by fact
      ultimately show ?case using yinequ by simp
    next
      case(Bang P a x P' u)
      have "P  !P ea<u> e (P'[x::=u])" by fact
      thus ?case by(rule Early_Semantics.Bang)
    qed
  qed

  have "c::name. c  (P, P')" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c  P" and cFreshP': "c  P'"
    by(force simp add: fresh_prod)
  from assms cFreshP' have "P la<c> l ([(x, c)]  P')"
    by(simp add: Late_Semantics.alphaBoundResidual)
  hence "P e a<u> e ([(x, c)]  P')[c::=u]" using cFreshP
    by(rule Goal)
  with cFreshP' show ?thesis by(simp add: renaming name_swap)
qed

lemma earlyLateInput:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   u  :: name
  and   C  :: "'a::fs_name"

  assumes "P ea<u> e P'"
  and     "x  P"

  shows "P''. P la<x> l P''  P' = P''[x::=u]"
proof -
  {
    fix P a u P'
    assume "P ea<u> e P'"
    hence "P'' x. P la<x> l P''  P' = P''[x::=u]"
    proof(nominal_induct rule: Early_Semantics.inputInduct)
      case(cInput a x P u)
      have "a<x>.P la<x>  P" by(rule Late_Semantics.Input)
      thus ?case by blast
    next
      case(cMatch P a u P' b)
      have "P'' x. P la<x>  P''  P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P la<x>  P''" and P'eqP'': "P' = P''[x::=u]" by blast
      from PTrans have "[bb]P la<x>  P''" by(rule Late_Semantics.Match)
      with P'eqP'' show ?case by blast
    next
      case(cMismatch P a u P' b c)
      have "P'' x. P la<x>  P''  P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P la<x>  P''" and P'eqP'': "P' = P''[x::=u]" by blast
      have "b  c" by fact
      with PTrans have "[bc]P la<x>  P''" by(rule Late_Semantics.Mismatch)
      with P'eqP'' show ?case by blast
    next
      case(cSum1 P a u P' Q)
      have "P'' x. P la<x>  P''  P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P la<x>  P''" and P'eqP'': "P' = P''[x::=u]" by blast
      from PTrans have "P  Q la<x>  P''" by(rule Late_Semantics.Sum1)
      with P'eqP'' show ?case by blast
    next
      case(cSum2 Q a u Q' P)
      have "Q'' x. Q la<x>  Q''  Q' = Q''[x::=u]" by fact
      then obtain Q'' x where QTrans: "Q la<x>  Q''" and Q'eqQ'': "Q' = Q''[x::=u]" by blast
      from QTrans have "P  Q la<x>  Q''" by(rule Late_Semantics.Sum2)
      with Q'eqQ'' show ?case by blast
    next
      case(cPar1 P a u P' Q)
      have "P'' x. P la<x>  P''  P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P la<x>  P''" and P'eqP'': "P' = P''[x::=u]" by blast
      have "c::name. c  (Q, P'')" by(blast intro: name_exists_fresh)
      then obtain c::name where cFreshQ: "c  Q" and cFreshP'': "c  P''" by(force simp add: fresh_prod)
      from PTrans cFreshP'' have "P la<c>  [(x, c)]  P''" by(simp add: Late_Semantics.alphaBoundResidual)
      hence "P  Q la<c>  ([(x, c)]  P'')  Q" using c  Q by(rule Late_Semantics.Par1B)
      moreover from cFreshQ cFreshP'' P'eqP'' have "P'  Q = (([(x, c)]  P'')  Q)[c::=u]"
        by(simp add: forget renaming name_swap)
      ultimately show ?case by blast
    next
      case(cPar2 Q a u Q' P)
      have "Q'' x. Q la<x>  Q''  Q' = Q''[x::=u]" by fact
      then obtain Q'' x where QTrans: "Q la<x>  Q''" and Q'eqQ'': "Q' = Q''[x::=u]" by blast
      have "c::name. c  (P, Q'')" by(blast intro: name_exists_fresh)
      then obtain c::name where cFreshP: "c  P" and cFreshQ'': "c  Q''" by(force simp add: fresh_prod)
      from QTrans cFreshQ'' have "Q la<c>  [(x, c)]  Q''" by(simp add: Late_Semantics.alphaBoundResidual)
      hence "P  Q la<c>  P  ([(x, c)]  Q'')" using c  P by(rule Late_Semantics.Par2B)
      moreover from cFreshP cFreshQ'' Q'eqQ'' have "P  Q' = (P  ([(x, c)]  Q''))[c::=u]"
        by(simp add: forget renaming name_swap)
      ultimately show ?case by blast
    next
      case(cRes P a u P' y)
      have "P'' x. P la<x>  P''  P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P la<x>  P''" and P'eqP'': "P' = P''[x::=u]" by blast
      have yinequ: "y  u" by fact
      have "c::name. c  (y, P'')" by(blast intro: name_exists_fresh)
      then obtain c::name where cineqy: "c  y" and cFreshP'': "c  P''" by(force simp add: fresh_prod)
      from PTrans cFreshP'' have "P la<c>  [(x, c)]  P''" by(simp add: Late_Semantics.alphaBoundResidual)
      moreover have "y  a" by fact
      ultimately have "y>P la<c>  y>(([(x, c)]  P''))" using cineqy
        by(force intro: Late_Semantics.ResB)
      moreover from cineqy cFreshP'' P'eqP'' yinequ have "y>P' = (y>([(x, c)]  P''))[c::=u]"
        by(simp add: renaming name_swap)
      ultimately show ?case by blast
    next
      case(cBang P a u P')
      have "P'' x. P  !P la<x>  P''  P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P  !P la<x>  P''" and P'eqP'': "P' = P''[x::=u]" by blast
      from PTrans have "!P la<x>  P''" by(rule Late_Semantics.Bang)
      with P'eqP'' show ?case by blast
    qed
  }
  with assms obtain P'' y where PTrans: "P la<y>  P''" and P'eqP'': "P' = P''[y::=u]" by blast
  show ?thesis
  proof(cases "x=y")
    case True
    from PTrans P'eqP'' x = y show ?thesis by blast
  next
    case False
    from PTrans x  y x  P have "x  P''" by(fastforce dest: freshBoundDerivative simp add: residual.inject)
    with PTrans have "P la<x> l ([(x, y)]  P'')"
      by(simp add: Late_Semantics.alphaBoundResidual)
    moreover from x  P'' have "P''[y::=u] = ([(x, y)]  P'')[x::=u]" by(simp add: renaming name_swap)
    ultimately show ?thesis using P'eqP'' by blast
  qed
qed
(*
lemma earlyLateInput:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   u  :: name
  and   C  :: "'a::fs_name"

  assumes PTrans: "P ⟼ea<u> ≺e P'"

  shows "∃P'' x. P ⟼la<x> ≺l P'' ∧ P' = P''[x::=u] ∧ x ♯ C"
proof -
  have "⋀P a u P'. P ⟼ea<u> ≺e P' ⟹ ∃P'' x. P ⟼la<x> ≺l P'' ∧ P' = P''[x::=u]"
  proof -
    fix P a u P'
    assume "P ⟼ea<u> ≺e P'"
    thus "∃P'' x. P ⟼la<x> ≺l P'' ∧ P' = P''[x::=u]"
    proof(nominal_induct rule: Early_Semantics.inputInduct)
      case(cInput a x P u)
      have "a<x>.P ⟼la<x> ≺ P" by(rule Late_Semantics.Input)
      thus ?case by blast
    next
      case(cMatch P a u P' b)
      have "∃P'' x. P ⟼la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P ⟼la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
      from PTrans have "[b⌢b]P ⟼la<x> ≺ P''" by(rule Late_Semantics.Match)
      with P'eqP'' show ?case by blast
    next
      case(cMismatch P a u P' b c)
      have "∃P'' x. P ⟼la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P ⟼la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
      have "b ≠ c" by fact
      with PTrans have "[b≠c]P ⟼la<x> ≺ P''" by(rule Late_Semantics.Mismatch)
      with P'eqP'' show ?case by blast
    next
      case(cSum1 P a u P' Q)
      have "∃P'' x. P ⟼la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P ⟼la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
      from PTrans have "P ⊕ Q ⟼la<x> ≺ P''" by(rule Late_Semantics.Sum1)
      with P'eqP'' show ?case by blast
    next
      case(cSum2 Q a u Q' P)
      have "∃Q'' x. Q ⟼la<x> ≺ Q'' ∧ Q' = Q''[x::=u]" by fact
      then obtain Q'' x where QTrans: "Q ⟼la<x> ≺ Q''" and Q'eqQ'': "Q' = Q''[x::=u]" by blast
      from QTrans have "P ⊕ Q ⟼la<x> ≺ Q''" by(rule Late_Semantics.Sum2)
      with Q'eqQ'' show ?case by blast
    next
      case(cPar1 P a u P' Q)
      have "∃P'' x. P ⟼la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P ⟼la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
      have "∃c::name. c ♯ (Q, P'')" by(blast intro: name_exists_fresh)
      then obtain c::name where cFreshQ: "c ♯ Q" and cFreshP'': "c ♯ P''" by(force simp add: fresh_prod)
      from PTrans cFreshP'' have "P ⟼la<c> ≺ [(x, c)] ∙ P''" by(simp add: Late_Semantics.alphaBoundResidual)
      hence "P ∥ Q ⟼la<c> ≺ ([(x, c)] ∙ P'') ∥ Q" using `c ♯ Q` by(rule Late_Semantics.Par1B)
      moreover from cFreshQ cFreshP'' P'eqP'' have "P' ∥ Q = (([(x, c)] ∙ P'') ∥ Q)[c::=u]"
        by(simp add: forget renaming name_swap)
      ultimately show ?case by blast
    next
      case(cPar2 Q a u Q' P)
      have "∃Q'' x. Q ⟼la<x> ≺ Q'' ∧ Q' = Q''[x::=u]" by fact
      then obtain Q'' x where QTrans: "Q ⟼la<x> ≺ Q''" and Q'eqQ'': "Q' = Q''[x::=u]" by blast
      have "∃c::name. c ♯ (P, Q'')" by(blast intro: name_exists_fresh)
      then obtain c::name where cFreshP: "c ♯ P" and cFreshQ'': "c ♯ Q''" by(force simp add: fresh_prod)
      from QTrans cFreshQ'' have "Q ⟼la<c> ≺ [(x, c)] ∙ Q''" by(simp add: Late_Semantics.alphaBoundResidual)
      hence "P ∥ Q ⟼la<c> ≺ P ∥ ([(x, c)] ∙ Q'')" using `c ♯ P` by(rule Late_Semantics.Par2B)
      moreover from cFreshP cFreshQ'' Q'eqQ'' have "P ∥ Q' = (P ∥ ([(x, c)] ∙ Q''))[c::=u]"
        by(simp add: forget renaming name_swap)
      ultimately show ?case by blast
    next
      case(cRes P a u P' y)
      have "∃P'' x. P ⟼la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P ⟼la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
      have yinequ: "y ≠ u" by fact
      have "∃c::name. c ♯ (y, P'')" by(blast intro: name_exists_fresh)
      then obtain c::name where cineqy: "c ≠ y" and cFreshP'': "c ♯ P''" by(force simp add: fresh_prod)
      from PTrans cFreshP'' have "P ⟼la<c> ≺ [(x, c)] ∙ P''" by(simp add: Late_Semantics.alphaBoundResidual)
      moreover have "y ≠ a" by fact
      ultimately have "<νy>P ⟼la<c> ≺ <νy>(([(x, c)] ∙ P''))" using cineqy
        by(force intro: Late_Semantics.ResB)
      moreover from cineqy cFreshP'' P'eqP'' yinequ have "<νy>P' = (<νy>([(x, c)] ∙ P''))[c::=u]"
        by(simp add: renaming name_swap)
      ultimately show ?case by blast
    next
      case(cBang P a u P')
      have "∃P'' x. P ∥ !P ⟼la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
      then obtain P'' x where PTrans: "P ∥ !P ⟼la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
      from PTrans have "!P ⟼la<x> ≺ P''" by(rule Late_Semantics.Bang)
      with P'eqP'' show ?case by blast
    qed
  qed
  with PTrans obtain P'' x where PTrans: "P ⟼la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
  have "∃c::name. c ♯ (P'', C)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP'': "c ♯ P''" and cFreshC: "c ♯ C" by force
  from cFreshP'' PTrans have "P ⟼la<c> ≺l ([(x, c)] ∙ P'')"
    by(simp add: Late_Semantics.alphaBoundResidual)
  moreover from cFreshP'' have "P''[x::=u] = ([(x, c)] ∙ P'')[c::=u]" by(simp add: renaming name_swap)
  ultimately show ?thesis using P'eqP'' cFreshC by blast
qed
*)
lemma lateEarlyTau:
  fixes P  :: pi
  and   P' :: pi

  assumes "P lτ l P'"

  shows "P eτ e P'"
using assms
proof(nominal_induct rule: Late_Semantics.tauInduct)
  case(Tau P)
  thus ?case by(rule Early_Semantics.Tau)
next
  case(Match P P' a)
  have "P eτ e P'" by fact
  thus "[aa]P eτ e P'" by(rule Early_Semantics.Match)
next
  case(Mismatch P P' a b)
  have "P eτ e P'" by fact
  moreover have "a  b" by fact
  ultimately show "[ab]P eτ e P'" by(rule Early_Semantics.Mismatch)
next
  case(Sum1 P P' Q)
  have "P eτ e P'" by fact
  thus "P  Q eτ e P'" by(rule Early_Semantics.Sum1)
next
  case(Sum2 Q Q' P)
  have "Q eτ e Q'" by fact
  thus "P  Q eτ e Q'" by(rule Early_Semantics.Sum2)
next
  case(Par1 P P' Q)
  have "P eτ e P'" by fact
  thus "P  Q eτ e P'  Q" by(rule Early_Semantics.Par1F)
next
  case(Par2 Q Q' P)
  have "Q eτ e Q'" by fact
  thus "P  Q eτ e P  Q'" by(rule Early_Semantics.Par2F)
next
  case(Comm1 P a x P' Q b Q')
  have "P ea<b> e P'[x::=b]"
  proof -
    have "P l a<x>  P'" by fact
    thus ?thesis by(rule lateEarlyInput)
  qed
  moreover have "Q ea[b] e Q'"
  proof -
    have "Q la[b] l Q'" by fact
    thus ?thesis by(rule lateEarlyOutput)
  qed
  ultimately show ?case by(rule Early_Semantics.Comm1)
next
  case(Comm2 P a b P' Q x Q')
  have "P ea[b] e P'"
  proof -
    have "P la[b] l P'" by fact
    thus ?thesis by(rule lateEarlyOutput)
  qed
  moreover have "Q ea<b> e Q'[x::=b]"
  proof -
    have "Q la<x> l Q'" by fact
    thus ?thesis by(rule lateEarlyInput)
  qed
  ultimately show ?case by(rule Early_Semantics.Comm2)
next
  case(Close1 P a x P' Q y Q')
  have "P ea<y> e P'[x::=y]"
  proof -
    have "P l a<x>  P'" by fact
    thus ?thesis by(rule lateEarlyInput)
  qed
  moreover have "Q eay>  Q'"
  proof -
    have "Q lay> l Q'" by fact
    thus ?thesis by(rule lateEarlyBoundOutput)
  qed
  moreover have "y  P" by fact
  ultimately show ?case by(rule Early_Semantics.Close1)
next
  case(Close2 P a y P' Q x Q')
  have "P eay>  P'"
  proof -
    have "P lay> l P'" by fact
    thus ?thesis by(rule lateEarlyBoundOutput)
  qed
  moreover have "Q ea<y> e Q'[x::=y]"
  proof -
    have "Q la<x> l Q'" by fact
    thus ?thesis by(rule lateEarlyInput)
  qed
  moreover have "y  Q" by fact
  ultimately show ?case by(rule Early_Semantics.Close2)
next
  case(Res P P' x)
  have "P eτ e P'" by fact
  thus ?case by(force intro: Early_Semantics.ResF)
next
  case(Bang P P')
  have "P  !P eτ e P'" by fact
  thus ?case by(rule Early_Semantics.Bang)
qed

lemma earlyLateTau:
  fixes P  :: pi
  and   P' :: pi

  assumes "P eτ e P'"

  shows "P lτ l P'"
using assms
proof(nominal_induct rule: Early_Semantics.tauInduct)
  case(Tau P)
  thus ?case by(rule Late_Semantics.Tau)
next
  case(Match P P' a)
  have "P lτ l P'" by fact
  thus ?case by(rule Late_Semantics.Match)
next
  case(Mismatch P P' a b)
  have "P lτ l P'" by fact
  moreover have "a  b" by fact
  ultimately show ?case by(rule Late_Semantics.Mismatch)
next
  case(Sum1 P P' Q)
  have "P lτ l P'" by fact
  thus ?case by(rule Late_Semantics.Sum1)
next
  case(Sum2 Q Q' P)
  have "Q lτ l Q'" by fact
  thus ?case by(rule Late_Semantics.Sum2)
next
  case(Par1 P P' Q)
  have "P lτ l P'" by fact
  thus ?case by(rule Late_Semantics.Par1F)
next
  case(Par2 Q Q' P)
  have "Q lτ l Q'" by fact
  thus ?case by(rule Late_Semantics.Par2F)
next
  case(Comm1 P a b P' Q Q')
  have "P ea<b> e P'" by fact
  moreover obtain x::name  where "x  P" by(generate_fresh "name") auto
  ultimately obtain P'' where PTrans: "P la<x>  P''" and P'eqP'': "P' = P''[x::=b]"
    by(blast dest: earlyLateInput)
  have "Q ea[b] e Q'" by fact
  hence "Q la[b] l Q'" by(rule earlyLateOutput)
  with PTrans P'eqP'' show ?case
    by(blast intro: Late_Semantics.Comm1)
next
  case(Comm2 P a b P' Q Q')
  have "P ea[b] e P'" by fact
  hence QTrans: "P la[b] l P'" by(rule earlyLateOutput)
  have "Q ea<b> e Q'" by fact
  moreover obtain x::name  where "x  Q" by(generate_fresh "name") auto
  ultimately obtain Q'' x where "Q la<x>  Q''" and "Q' = Q''[x::=b]"
    by(blast dest: earlyLateInput)
  with QTrans show ?case
    by(blast intro: Late_Semantics.Comm2)
next
  case(Close1 P a x P' Q Q')
  have  "P ea<x> e P'" and "x  P" by fact+
  then obtain P'' where "P la<x>  P''" and "P' = P''[x::=x]"
    by(blast dest: earlyLateInput)
  
  moreover have "Q eax> e Q'" by fact
  hence "Q lax> l Q'" by(rule earlyLateBoundOutput)
  moreover have "x  P" by fact
  ultimately show ?case
    by(blast intro: Late_Semantics.Close1)
next
  case(Close2 P a x P' Q Q')
  have  "P eax> e P'" by fact
  hence PTrans: "P lax> l P'" by(rule earlyLateBoundOutput)

  have "Q ea<x> e Q'" and "x  Q" by fact+
  then obtain Q'' y where "Q la<x>  Q''" and "Q' = Q''[x::=x]"
    by(blast dest: earlyLateInput)
  moreover have "x  Q" by fact
  ultimately show ?case using PTrans
    by(blast intro: Late_Semantics.Close2)
next
  case(Res P P' x)
  have  "P lτ l P'" by fact
  thus ?case by(force intro: Late_Semantics.ResF)
next
  case(Bang P P')
  have  "P  !P lτ l P'" by fact
  thus ?case by(force intro: Late_Semantics.Bang)
qed

lemma tauEq:
  fixes P  :: pi
  and   P' :: pi

  shows "P e(Early_Semantics.FreeR Early_Semantics.TauR P') = P τ l P'"
by(auto intro: earlyLateTau lateEarlyTau)

(****************** Simulation ******************)

abbreviation simLate_judge ("_ l[_] _" [80, 80, 80] 80) where "P l[Rel] Q  Strong_Late_Sim.simulation P Rel Q"
abbreviation simEarly_judge ("_ e[_] _" [80, 80, 80] 80) where "P e[Rel] Q  Strong_Early_Sim.strongSimEarly P Rel Q"

lemma lateEarlySim:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi × pi) set"

  assumes PSimQ: "P l[Rel] Q"

  shows "P e[Rel] Q"
proof(induct rule: Strong_Early_Sim.simCases)
  case(Bound a x Q')
  have "Q eax> e Q'" by fact
  hence "Q lax> l Q'" by(rule earlyLateBoundOutput)
  moreover have "x  P" by fact
  ultimately obtain P' where PTrans: "P lax> l P'" and P'RelQ': "(P', Q')  Rel" using PSimQ
    by(force dest: Strong_Late_Sim.simE simp add: derivative_def)
  from PTrans have "P eax> e P'" by(rule lateEarlyBoundOutput)
  with P'RelQ' show ?case by blast
next
  case(Free α Q')
  have "Q e Early_Semantics.residual.FreeR α Q'" by fact
  thus ?case
  proof(nominal_induct α rule: freeRes.strong_induct)
    case(InputR a u)
    obtain x::name where "x  Q" and "x  P" by(generate_fresh "name") auto
    with Q ea<u> e Q' obtain Q'' where QTrans: "Q la<x> l Q''" and Q'eqQ'': "Q' = Q''[x::=u]"
      by(blast dest: earlyLateInput)
    from PSimQ QTrans x  P  obtain P' where PTrans: "P la<x>  P'"
                                          and P'RelQ': "(P'[x::=u], Q''[x::=u])  Rel"
      by(force dest: Strong_Late_Sim.simE simp add: derivative_def)
    from PTrans have "P ea<u> e P'[x::=u]" by(rule lateEarlyInput)
    with P'RelQ' Q'eqQ'' show "P'. P ea<u> e P'  (P', Q')  Rel" by blast
  next
    case(OutputR a b)
    from Q ea[b] e Q' have "Q la[b] l Q'" by(rule earlyLateOutput)
    with PSimQ obtain P' where PTrans: "P la[b] l P'" and P'RelQ': "(P', Q')  Rel"
      by(blast dest: Strong_Late_Sim.simE)
    from PTrans have "P ea[b] e P'" by(rule lateEarlyOutput)
    with P'RelQ' show "P'. P ea[b] e P'  (P', Q')  Rel"  by blast
  next
    case TauR
    from Q eτ e Q' have "Q lτ l Q'" by(rule earlyLateTau)
    with PSimQ obtain P' where PTrans: "P lτ l P'" and P'RelQ': "(P', Q')  Rel"
      by(blast dest: Strong_Late_Sim.simE)
    from PTrans have "P eτ e P'" by(rule lateEarlyTau)
    with P'RelQ' show "P'. P eτ e P'  (P', Q')  Rel"  by blast
  qed
qed

(*************** Bisimulation ***************)

abbreviation bisimLate_judge ("_ l _" [80, 80] 80) where "P l Q  (P, Q)  Strong_Late_Bisim.bisim"
abbreviation bisimEarly_judge ("_ e _" [80, 80] 80) where "P e Q  (P, Q)  Strong_Early_Bisim.bisim"

lemma lateEarlyBisim:
  fixes P :: pi
  and   Q :: pi

  assumes "P l Q"

  shows "P e Q"
using assms
by(coinduct rule: Strong_Early_Bisim.weak_coinduct)
  (auto dest: Strong_Late_Bisim.bisimE Strong_Late_Bisim.symmetric intro: lateEarlySim)


(*************** Congruence ***************)

abbreviation congLate_judge ("_ sl _" [80, 80] 80) where "P sl Q  (P, Q)  (substClosed Strong_Late_Bisim.bisim)"
abbreviation congEarly_judge ("_ se _" [80, 80] 80) where "P se Q  (P, Q)  (substClosed Strong_Early_Bisim.bisim)"

lemma lateEarlyCong:
  fixes P :: pi
  and   Q :: pi

  assumes "P sl Q"

  shows "P se Q"
using assms
by(auto simp add: substClosed_def intro: lateEarlyBisim)

lemma earlyCongStructCong:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"

  shows "P se Q"
using assms lateEarlyCong bisimSubstStructCong
by blast


lemma earlyBisimStructCong:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"

  shows "P e Q"
using assms lateEarlyBisim structCongBisim
by blast

end

Theory Strong_Early_Bisim_SC

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Early_Bisim_SC
  imports Strong_Early_Bisim Strong_Late_Bisim_SC Strong_Early_Late_Comp
begin

(******** Structural Congruence **********)

(******** The ν-operator *****************)

lemma resComm:
  fixes P :: pi
  
  shows "a>b>P e b>a>P"
proof -
  have "a>b>P l b>a>P" by(rule Strong_Late_Bisim_SC.resComm)
  thus ?thesis by(rule lateEarlyBisim)
qed

(******** Match *********)

lemma matchId:
  fixes a :: name
  and   P :: pi

  shows "[aa]P e P"
proof -
  have "[aa]P l P" by(rule Strong_Late_Bisim_SC.matchId)
  thus ?thesis by(rule lateEarlyBisim)
qed

(******** Mismatch *********)

lemma mismatchId:
  fixes a :: name
  and   b :: name
  and   P :: pi

  assumes "a  b"

  shows "[ab]P e P"
proof -
  from assms have "[ab]P l P" by(rule Strong_Late_Bisim_SC.mismatchId)
  thus ?thesis by(rule lateEarlyBisim)
qed

lemma mismatchNil:
  fixes a :: name
  and   P :: pi
  
  shows "[aa]P e 𝟬"
proof -
  have "[aa]P l 𝟬" by(rule Strong_Late_Bisim_SC.mismatchNil)
  thus ?thesis by(rule lateEarlyBisim)
qed

(******** The +-operator *********)

lemma sumSym:
  fixes P :: pi
  and   Q :: pi
  
  shows "P  Q e Q  P"
proof -
  have "P  Q l Q  P" by(rule Strong_Late_Bisim_SC.sumSym)
  thus ?thesis by(rule lateEarlyBisim)
qed

lemma sumAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  shows "(P  Q)  R e P  (Q  R)"
proof -
  have "(P  Q)  R l P  (Q  R)" by(rule Strong_Late_Bisim_SC.sumAssoc)
  thus ?thesis by(rule lateEarlyBisim)
qed

lemma sumZero:
  fixes P :: pi
  
  shows "P  𝟬 e P"
proof -
  have "P  𝟬 l P" by(rule Strong_Late_Bisim_SC.sumZero)
  thus ?thesis by(rule lateEarlyBisim)
qed

(******** The |-operator *********)

lemma parZero:
  fixes P :: pi

  shows "P  𝟬 e P"
proof -
  have "P  𝟬 l P" by(rule Strong_Late_Bisim_SC.parZero)
  thus ?thesis by(rule lateEarlyBisim)
qed

lemma parSym:
  fixes P :: pi
  and   Q :: pi

  shows "P  Q e Q  P"
proof -
  have "P  Q l Q  P" by(rule Strong_Late_Bisim_SC.parSym)
  thus ?thesis by(rule lateEarlyBisim)
qed

lemma scopeExtPar:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x  P"

  shows "x>(P  Q) e P  x>Q"
proof -
  from assms have "x>(P  Q) l P  x>Q" by(rule Strong_Late_Bisim_SC.scopeExtPar)
  thus ?thesis by(rule lateEarlyBisim)
qed

lemma scopeExtPar':
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes xFreshQ: "x  Q"

  shows "x>(P  Q) e (x>P)  Q"
proof -
  from assms have "x>(P  Q) l (x>P)  Q" by(rule Strong_Late_Bisim_SC.scopeExtPar')
  thus ?thesis by(rule lateEarlyBisim)
qed

lemma parAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  shows "(P  Q)  R e P  (Q  R)"
proof -
  have "(P  Q)  R l P  (Q  R)" by(rule Strong_Late_Bisim_SC.parAssoc)
  thus ?thesis by(rule lateEarlyBisim)
qed

lemma freshRes:
  fixes P :: pi
  and   a :: name

  assumes aFreshP: "a  P"

  shows "a>P e P"
proof -
  from aFreshP have "a>P l P" by(rule Strong_Late_Bisim_SC.scopeFresh)
  thus ?thesis by(rule lateEarlyBisim)
qed

lemma scopeExtSum:
  fixes P :: pi
  and   Q :: pi
  and   x :: name
  
  assumes "x  P"

  shows "x>(P  Q) e P  x>Q"
proof -
  from x  P  have "x>(P  Q) l P  x>Q" by(rule Strong_Late_Bisim_SC.scopeExtSum)
  thus ?thesis by(rule lateEarlyBisim)
qed

lemma bangSC:
  fixes P

  shows "!P e P  !P"
proof -
  have "!P l P  !P" by(rule Strong_Late_Bisim_SC.bangSC)
  thus ?thesis by(rule lateEarlyBisim)
qed

end

Theory Weak_Early_Bisim_SC

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Bisim_SC
  imports Weak_Early_Bisim Strong_Early_Bisim_SC
begin

(******** Structural Congruence **********)

lemma weakBisimStructCong:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"

  shows "P  Q"
using assms
by(metis earlyBisimStructCong strongBisimWeakBisim)

lemma matchId:
  fixes a :: name
  and   P :: pi

  shows "[aa]P  P"
proof -
  have "[aa]P e P" by(rule Strong_Early_Bisim_SC.matchId)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma mismatchId:
  fixes a :: name
  and   b :: name
  and   P :: pi

  assumes "a  b"

  shows "[ab]P  P"
proof -
  from a  b have "[ab]P e P" by(rule Strong_Early_Bisim_SC.mismatchId)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma mismatchNil:
  fixes a :: name
  and   P :: pi

  shows "[aa]P  𝟬"
proof -
  have "[aa]P e 𝟬" by(rule Strong_Early_Bisim_SC.mismatchNil)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

(******** The ν-operator *****************)

lemma resComm:
  fixes P :: pi
  
  shows "a>b>P  b>a>P"
proof -
  have "a>b>P e b>a>P" by(rule Strong_Early_Bisim_SC.resComm)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

(******** The +-operator *********)

lemma sumSym:
  fixes P :: pi
  and   Q :: pi
  
  shows "P  Q  Q  P"
proof -
  have "P  Q e Q  P" by(rule Strong_Early_Bisim_SC.sumSym)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma sumAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  shows "(P  Q)  R  P  (Q  R)"
proof -
  have "(P  Q)  R e P  (Q  R)" by(rule Strong_Early_Bisim_SC.sumAssoc)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma sumZero:
  fixes P :: pi
  
  shows "P  𝟬  P"
proof -
  have "P  𝟬 e P" by(rule Strong_Early_Bisim_SC.sumZero)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

(******** The |-operator *********)

lemma parZero:
  fixes P :: pi

  shows "P  𝟬  P"
proof -
  have "P  𝟬 e P" by(rule Strong_Early_Bisim_SC.parZero)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma parSym:
  fixes P :: pi
  and   Q :: pi

  shows "P  Q  Q  P"
proof -
  have "P  Q e Q  P" by(rule Strong_Early_Bisim_SC.parSym)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma scopeExtPar:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x  P"

  shows "x>(P  Q)  P  x>Q"
proof -
  from x  P have "x>(P  Q) e P  x>Q" by(rule Strong_Early_Bisim_SC.scopeExtPar)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma scopeExtPar':
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x  Q"

  shows "x>(P  Q)  (x>P)  Q"
proof - 
  from x  Q have "x>(P  Q) e (x>P)  Q" by(rule Strong_Early_Bisim_SC.scopeExtPar')
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma parAssoc:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  shows "(P  Q)  R  P  (Q  R)"
proof -
  have "(P  Q)  R e P  (Q  R)" by(rule Strong_Early_Bisim_SC.parAssoc)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma freshRes:
  fixes P :: pi
  and   a :: name

  assumes "a  P"

  shows "a>P  P"
proof -
  from a  P have "a>P e P" by(rule Strong_Early_Bisim_SC.freshRes)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma scopeExtSum:
  fixes P :: pi
  and   Q :: pi
  and   x :: name
  
  assumes "x  P"

  shows "x>(P  Q)  P  x>Q"
proof -
  from x  P have "x>(P  Q) e P  x>Q" by(rule Strong_Early_Bisim_SC.scopeExtSum)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma bangSC:
  fixes P

  shows "!P  P  !P"
proof -
  have "!P e P  !P" by(rule Strong_Early_Bisim_SC.bangSC)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

end

Theory Weak_Early_Bisim_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Bisim_Pres
  imports Strong_Early_Bisim_Pres Weak_Early_Sim_Pres Weak_Early_Bisim_SC Weak_Early_Bisim
begin

(************ Preservation rules ************)

lemma tauPres:
  fixes P :: pi
  and   Q :: pi

  assumes "P  Q"

  shows "τ.(P)  τ.(Q)"
proof -
  let ?X = "{(τ.(P), τ.(Q)) | P Q. P  Q}"
  from P  Q have "(τ.(P), τ.(Q))  ?X" by auto
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim P Q)
    thus ?case
      by(force intro: Weak_Early_Sim_Pres.tauPres)
  next
    case(cSym P Q)
    thus ?case by(force dest: Weak_Early_Bisim.symetric simp add: pi.inject)
  qed
qed

lemma outputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "a{b}.P  a{b}.Q"
proof -
  let ?X = "{(a{b}.(P), a{b}.(Q)) | P Q a b. P  Q}"
  from P  Q have "(a{b}.(P), a{b}.(Q))  ?X" by auto
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim P Q)
    thus ?case
      by(force intro: Weak_Early_Sim_Pres.outputPres)
  next
    case(cSym P Q)
    thus ?case by(force dest: Weak_Early_Bisim.symetric simp add: pi.inject)
  qed
qed

lemma inputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   x :: name

  assumes PSimQ: "y. P[x::=y]  Q[x::=y]"
  
  shows "a<x>.P  a<x>.Q"
proof -
  let ?X = "{(a<x>.P, a<x>.Q) | a x P Q. y. P[x::=y]  Q[x::=y]}"
  {
    fix axP axQ p
    assume "(axP, axQ)  ?X"
    then obtain a x P Q where A: "y. P[x::=y]  Q[x::=y]" and B: "axP = a<x>.P" and C: "axQ = a<x>.Q"
      by auto
    have "y. ((p::name prm)  P)[(p  x)::=y]  (p  Q)[(p  x)::=y]"
    proof -
      fix y
      from A have "P[x::=(rev p  y)]  Q[x::=(rev p  y)]"
        by blast
      hence "(p  (P[x::=(rev p  y)]))  p  (Q[x::=(rev p  y)])"
        by(rule eqvts)
      thus "(p  P)[(p  x)::=y]  (p  Q)[(p  x)::=y]"
        by(simp add: eqvts pt_pi_rev[OF pt_name_inst, OF at_name_inst])
    qed
    hence "((p::name prm)  axP, p  axQ)  ?X" using B C
      by auto
  }
  hence "eqvt ?X" by(simp add: eqvt_def)

  from PSimQ have "(a<x>.P, a<x>.Q)  ?X" by auto
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim P Q)
    thus ?case using ‹eqvt ?X
      by(force intro: Weak_Early_Sim_Pres.inputPres)
  next
    case(cSym P Q)
    thus ?case
      by(blast dest: weakBisimE)
  qed
qed

lemma resPres:
  fixes P :: pi
  and   Q :: pi
  and   x :: name
  
  assumes "P  Q"

  shows "x>P  x>Q"
proof -
  let ?X = "{(x>P, x>Q) | x P Q. P  Q}"
  from P  Q have "(x>P, x>Q)  ?X" by blast
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim xP xQ)
    {
      fix P Q x
      assume "P  Q"
      hence "P ↝<weakBisim> Q" by(rule weakBisimE)
      moreover have "P Q x. P  Q  (x>P, x>Q)  ?X  weakBisim" by blast
      moreover have "weakBisim  ?X  weakBisim" by blast
      moreover have "eqvt weakBisim" by simp
      moreover have "eqvt (?X  weakBisim)"
        by(auto simp add: eqvt_def dest: Weak_Early_Bisim.eqvtI)+
      ultimately have "x>P ↝<(?X  weakBisim)> x>Q"
        by(rule Weak_Early_Sim_Pres.resPres)
    }
    with (xP, xQ)  ?X show ?case by blast
  next
    case(cSym xP xQ)
    thus ?case by(blast dest: Weak_Early_Bisim.symetric)
  qed
qed

lemma matchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
proof -
  let ?X = "{([ab]P, [ab]Q) | a b P Q. P  Q}"
  from P  Q have "([ab]P, [ab]Q)  ?X" by blast
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim abP abQ)
    {
      fix P Q a b
      assume "P  Q"
      hence "P ↝<weakBisim> Q" by(rule weakBisimE)
      moreover have "weakBisim  (?X  weakBisim)" by blast
      moreover have "P Q a. P  Q  [aa]P  Q"
        by (metis (full_types) strongBisimWeakBisim Strong_Early_Bisim_SC.matchId Weak_Early_Bisim.transitive)
      ultimately have"[ab]P ↝<(?X  weakBisim)> [ab]Q" 
        by(rule Weak_Early_Sim_Pres.matchPres)
    }
    with (abP, abQ)  ?X show ?case by blast
  next
    case(cSym abP abQ)
    thus ?case by(blast dest: Weak_Early_Bisim.symetric)
  qed
qed

lemma mismatchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
proof -
  let ?X = "{([ab]P, [ab]Q)| a b P Q. P  Q}"
  from P  Q have "([ab]P, [ab]Q)  ?X" by blast
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSim abP abQ)
    {
      fix P Q a b
      assume "P  Q"
      hence "P ↝<weakBisim> Q" by(rule weakBisimE)
      moreover have "weakBisim  (?X  weakBisim)" by blast
      moreover have "P Q a b. P  Q; a  b  [ab]P  Q"
        by (metis (full_types) strongBisimWeakBisim Strong_Early_Bisim_SC.mismatchId Weak_Early_Bisim.transitive)
      ultimately have "[ab]P ↝<(?X  weakBisim)> [ab]Q"
        by(rule Weak_Early_Sim_Pres.mismatchPres) 
    }
    with (abP, abQ)  ?X show ?case by blast
  next
    case(cSym abP abQ)
    thus ?case by(blast dest: Weak_Early_Bisim.symetric)
  qed
qed

lemma parPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P  Q"

  shows "P  R  Q  R"
proof -
  let ?X = "{(resChain lst (P  R), resChain lst (Q  R)) | lst P R Q. P  Q}"
  have BC: "P Q. P  Q = resChain [] (P  Q)" by auto
  from P  Q have "(P  R, Q  R)  ?X" by(blast intro: BC)
  thus ?thesis
  proof(coinduct rule: weakBisimCoinduct)
    case(cSym PR QR)
    {
      fix P Q R lst
      assume "P  Q"
      moreover hence "P ↝<weakBisim> Q" by(rule weakBisimE)
      moreover have "P Q R. P  Q  (P  R, Q  R)  ?X" using BC
        by blast
      moreover {
        fix PR QR x
        assume "(PR, QR)  ?X"
        then obtain lst P Q R where "P  Q" and A: "PR = resChain lst (P  R)" and B: "QR = resChain lst (Q  R)"
          by auto
        from A have "x>PR = resChain (x#lst) (P  R)" by auto
        moreover from B have "x>QR = resChain (x#lst) (Q  R)" by auto
        ultimately have "(x>PR, x>QR)  ?X" using P  Q
          by blast
      }
      note Res = this
      ultimately have "P  R ↝<?X> Q  R"
        by(rule_tac Weak_Early_Sim_Pres.parPres)
      moreover have "eqvt ?X"
        by(auto simp add: eqvt_def) (blast intro: eqvts)
      ultimately have "resChain lst (P  R) ↝<?X> resChain lst (Q  R)" using Res
        by(rule_tac Weak_Early_Sim_Pres.resChainI)
      hence "resChain lst (P  R) ↝<(?X  weakBisim)> resChain lst (Q  R)"
        by(force intro: Weak_Early_Sim.monotonic)
    }
    with (PR, QR)  ?X show "PR ↝<(?X  weakBisim)> QR"
      by blast
  next
    case(cSym PR QR)
    thus ?case by(blast dest: Weak_Early_Bisim.symetric)
  qed
qed

lemma bangPres:
  fixes P :: pi
  and   Q :: pi

  assumes PBisimQ: "P  Q"

  shows "!P  !Q"
proof -
  let ?X = "(bangRel weakBisim)"
  let ?Y = "Strong_Early_Bisim.bisim O (bangRel weakBisim) O Strong_Early_Bisim.bisim"

  from Weak_Early_Bisim.eqvt Strong_Early_Bisim.eqvt have eqvtY: "eqvt ?Y" by(blast intro: eqvtBangRel)
  have XsubY: "?X  ?Y" by(auto intro: Strong_Early_Bisim.reflexive)

  have RelStay: "P Q. (P  !P, Q)  ?Y  (!P, Q)  ?Y"
  proof(auto)
    fix P Q R T
    assume PBisimQ: "P  !P e Q" 
       and QBRR: "(Q, R)  bangRel weakBisim"
       and RBisimT: "R e T"
    have "!P e Q" 
    proof -
      have "!P e P  !P" by(rule Strong_Early_Bisim_SC.bangSC)
      thus ?thesis using PBisimQ by(rule Strong_Early_Bisim.transitive)
    qed
    with QBRR RBisimT show "(!P, T)  ?Y" by blast
  qed
 
  have ParCompose: "P Q R T. P  Q; (R, T)  ?Y  (P  R, Q  T)  ?Y"
  proof -
    fix P Q R T
    assume PBisimQ: "P  Q"
       and RYT:     "(R, T)  ?Y"
    thus "(P  R, Q  T)  ?Y"
    proof(auto)
      fix T' R'
      assume T'BisimT: "T' e T" and RBisimR': "R e R'"
         and R'BRT': "(R', T')  bangRel weakBisim"
      have "P  R e P  R'"
      proof -
        from RBisimR' have "R  P e R'  P" by(rule Strong_Early_Bisim_Pres.parPres)
        moreover have "P  R e R  P" and "R'  P e P  R'" by(rule Strong_Early_Bisim_SC.parSym)+
        ultimately show ?thesis by(blast intro: Strong_Early_Bisim.transitive)
      qed
      moreover from PBisimQ R'BRT' have "(P  R', Q  T')  bangRel weakBisim" by(rule BRPar)
      moreover have "Q  T' e Q  T"
      proof -
        from T'BisimT have "T'  Q e T  Q" by(rule Strong_Early_Bisim_Pres.parPres)
        moreover have "Q  T' e T'  Q" and "T  Q e Q  T" by(rule Strong_Early_Bisim_SC.parSym)+
        ultimately show ?thesis by(blast intro: Strong_Early_Bisim.transitive)
      qed
      ultimately show ?thesis by blast
    qed
  qed

  have ResCong: "P Q x. (P, Q)  ?Y  (x>P, x>Q)  ?Y"
    by(auto intro: BRRes Strong_Early_Bisim_Pres.resPres transitive)

  have Sim: "P Q. (P, Q)  ?X  P ↝<?Y> Q"
  proof -
    fix P Q
    assume "(P, Q)  ?X"
    thus "P ↝<?Y> Q"
    proof(induct)
      case(BRBang P Q)
      have "P  Q" by fact
      moreover hence "P ↝<weakBisim> Q" by(blast dest: weakBisimE)
      moreover have "P Q. P  Q  P ↝<weakBisim> Q" by(blast dest: weakBisimE)
      moreover from Strong_Early_Bisim.eqvt Weak_Early_Bisim.eqvt have "eqvt ?Y" by(blast intro: eqvtBangRel)

      ultimately show "!P ↝<?Y> !Q" using ParCompose ResCong RelStay XsubY
        by(rule_tac Weak_Early_Sim_Pres.bangPres, simp_all)
    next
      case(BRPar P Q R T)
      have PBiSimQ: "P  Q" by fact
      moreover have RBangRelT: "(R, T)  ?X" by fact
      have RSimT: "R ↝<?Y> T" by fact
      moreover from PBiSimQ  have "P ↝<weakBisim> Q" by(blast dest: weakBisimE)
      moreover from RBangRelT have "(R, T)  ?Y" by(blast intro: Strong_Early_Bisim.reflexive)
      ultimately show "P  R ↝<?Y> Q  T" using ParCompose ResCong eqvt eqvtY
        by(rule_tac Weak_Early_Sim_Pres.parCompose)
    next
      case(BRRes P Q x)
      have "P ↝<?Y> Q" by fact
      thus "x>P ↝<?Y> x>Q" using ResCong eqvtY XsubY
        by(rule_tac Weak_Early_Sim_Pres.resPres, simp_all)
    qed
  qed

  from PBisimQ have "(!P, !Q)  ?X" by(rule BRBang)
  moreover from Weak_Early_Bisim.eqvt have "eqvt (bangRel weakBisim)" by(rule eqvtBangRel)
  ultimately show ?thesis
    apply(coinduct rule: Weak_Early_Bisim.transitive_coinduct_weak)
    apply(blast intro: Sim)
    by(blast dest: bangRelSymetric Weak_Early_Bisim.symetric intro: Strong_Early_Bisim.reflexive)
qed

lemma bangRelSubWeakBisim:
  shows "bangRel weakBisim  weakBisim"
proof(auto)
  fix a b
  assume "(a, b)  bangRel weakBisim"
  thus "a  b"
  proof(induct)
    fix P Q
    assume "P  Q"
    thus "!P  !Q" by(rule bangPres)
  next
    fix P Q R T
    assume "R  T" and "P  Q"
    thus "R  P  T  Q" by(metis parPres parSym Weak_Early_Bisim.transitive)
  next
    fix P Q
    fix a::name
    assume "P  Q"
    thus "a>P  a>Q" by(rule resPres)
  qed
qed

end

Theory Weak_Early_Cong_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Cong_Pres
  imports Weak_Early_Cong Weak_Early_Step_Sim_Pres Weak_Early_Bisim_Pres
begin

lemma tauPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P  Q"

  shows "τ.(P)  τ.(Q)"
proof -
  from assms have "P  Q" by(rule congruenceWeakBisim)
  thus ?thesis by(force intro: Weak_Early_Step_Sim_Pres.tauPres simp add: weakCongruence_def dest: weakBisimE(2))
qed

lemma outputPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P  Q"

  shows "a{b}.P  a{b}.Q"
proof -
  from assms have "P  Q" by(rule congruenceWeakBisim)
  thus ?thesis by(force intro: Weak_Early_Step_Sim_Pres.outputPres simp add: weakCongruence_def dest: weakBisimE(2))
qed

lemma matchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
using assms
by(auto simp add: weakCongruence_def intro: Weak_Early_Step_Sim_Pres.matchPres)

lemma mismatchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P  Q"

  shows "[ab]P  [ab]Q"
using assms
by(auto simp add: weakCongruence_def intro: Weak_Early_Step_Sim_Pres.mismatchPres)

lemma sumPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P  Q"

  shows "P  R  Q  R"
using assms
by(auto simp add: weakCongruence_def intro: Weak_Early_Step_Sim_Pres.sumPres Weak_Early_Bisim.reflexive)

lemma parPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P  Q"

  shows "P  R  Q  R"
proof -
  have "P Q R. P ↝«weakBisim» Q; P  Q  P  R ↝«weakBisim» Q  R"
  proof -
    fix P Q R
    assume "P ↝«weakBisim» Q" and "P  Q"
    thus "P  R ↝«weakBisim» Q  R"
      using Weak_Early_Bisim_Pres.parPres Weak_Early_Bisim_Pres.resPres Weak_Early_Bisim.reflexive Weak_Early_Bisim.eqvt
      by(blast intro: Weak_Early_Step_Sim_Pres.parPres)
  qed
  moreover from assms have "P  Q" by(rule congruenceWeakBisim)
  ultimately show ?thesis using assms
    by(auto simp add: weakCongruence_def dest: weakBisimE)
qed

lemma resPres:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes PeqQ: "P  Q"
  
  shows "x>P  x>Q"
proof -
  have "P Q x. P ↝«weakBisim» Q  x>P ↝«weakBisim» x>Q"
  proof -
    fix P Q x
    assume "P ↝«weakBisim» Q"
    with Weak_Early_Bisim.eqvt Weak_Early_Bisim_Pres.resPres show "x>P ↝«weakBisim» x>Q"
      by(blast intro: Weak_Early_Step_Sim_Pres.resPres)
  qed
  with assms show ?thesis by(simp add: weakCongruence_def)
qed

lemma bangPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P  Q"

  shows "!P  !Q"
using assms
proof(induct rule: weakCongISym2)
  case(cSim P Q)
  let ?X = "{(P, Q) | P Q. P  Q}"
  from P  Q  have "(P, Q)  ?X"  by auto
  moreover have "P Q. (P, Q)  ?X  P ↝«weakBisim» Q" by(auto simp add: weakCongruence_def)
  moreover from congruenceWeakBisim have "?X  weakBisim" by auto
  ultimately have "!P ↝«bangRel weakBisim» !Q" using Weak_Early_Bisim.eqvt 
    by(rule Weak_Early_Step_Sim_Pres.bangPres)
  moreover have "bangRel weakBisim  weakBisim" by(rule bangRelSubWeakBisim)
  ultimately show "!P ↝«weakBisim» !Q"
    by(rule Weak_Early_Step_Sim.monotonic)
qed
  
end

Theory Weak_Early_Cong_Subst_Pres

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Cong_Subst_Pres
  imports Weak_Early_Cong_Subst Weak_Early_Cong_Pres
begin

lemma weakCongStructCong:
  fixes P :: pi
  and   Q :: pi

  assumes "P s Q"

  shows "P s Q"
using assms
by(metis earlyCongStructCong strongEqWeakCong)


lemma tauPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "τ.(P) s τ.(Q)"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.tauPres)

lemma inputPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   x :: name

  assumes PeqQ: "P s Q"

  shows "a<x>.P s a<x>.Q"
proof(auto simp add: weakCongruenceSubst_def)
  fix s::"(name × name) list"

  from congruenceWeakBisim have Input: "P Q a x s. P[<s>] s Q[<s>]; x  s  (a<x>.P)[<s>]  (a<x>.Q)[<s>]"
    apply(auto simp add: weakCongruenceSubst_def weakCongruence_def)
    apply(rule Weak_Early_Step_Sim_Pres.inputPres, auto)
    apply(erule_tac x="[(x, y)]" in allE, auto)
    apply(rule Weak_Early_Step_Sim_Pres.inputPres, auto)
    by(erule_tac x="[(x, y)]" in allE, auto)

  then obtain c::name where cFreshP: "c  P" and cFreshQ: "c  Q" and cFreshs: "c  s"
    by(force intro: name_exists_fresh[of "(P, Q, s)"])

  from PeqQ have "P[<([(x, c)]  s)>] s Q[<([(x, c)]  s)>]" by(rule partUnfold)
  hence "([(x, c)]  P[<([(x, c)]  s)>]) s  ([(x, c)]  Q[<([(x, c)]  s)>])" by(rule Weak_Early_Cong_Subst.eqvtI)
  hence "([(x, c)]  P)[<s>] s ([(x, c)]  Q)[<s>]" by simp
  hence "(a<c>.([(x, c)]  P))[<s>]  (a<c>.([(x, c)]  Q))[<s>]" using cFreshs by(rule Input)

  moreover from cFreshP cFreshQ have "a<x>.P = a<c>.([(x, c)]  P)" and "a<x>.Q = a<c>.([(x, c)]  Q)"
    by(simp add: Agent.alphaInput)+

  ultimately show "(a<x>.P)[<s>]  (a<x>.Q)[<s>]" by simp
qed

lemma outputPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "a{b}.P s a{b}.Q"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.outputPres)

lemma matchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P s Q"

  shows "[ab]P s [ab]Q"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.matchPres)

lemma mismatchPres:
  fixes P :: pi
  and   Q :: pi
  and   a :: name
  and   b :: name

  assumes "P s Q"

  shows "[ab]P s [ab]Q"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.mismatchPres)

lemma sumPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P s Q"

  shows "P  R s Q  R"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.sumPres)

lemma parPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "P s Q"

  shows "P  R s Q  R"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.parPres)

lemma resPres:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes PeqQ: "P s Q"
  
  shows "x>P s x>Q"
proof(auto simp add: weakCongruenceSubst_def)
  fix s::"(name × name) list"

  have Goal: "P Q x s. P[<s>] ↝«weakBisim» Q[<s>]; x  s  (x>P)[<s>] ↝«weakBisim» (x>Q)[<s>]"
    by(force intro: Weak_Early_Step_Sim_Pres.resPres Weak_Early_Bisim_Pres.resPres Weak_Early_Bisim.eqvt)
  
  then obtain c::name where cFreshP: "c  P" and cFreshQ: "c  Q" and cFreshs: "c  s"
    by(force intro: name_exists_fresh[of "(P, Q, s)"])

  from PeqQ have "P[<([(x, c)]  s)>] ↝«weakBisim» Q[<([(x, c)]  s)>]" and 
                 "Q[<([(x, c)]  s)>] ↝«weakBisim» P[<([(x, c)]  s)>]"
    by(force simp add: weakCongruenceSubst_def weakCongruence_def)+

  hence "([(x, c)]  (P[<([(x, c)]  s)>])) ↝«weakBisim» ([(x, c)]  (Q[<([(x, c)]  s)>]))" and 
        "([(x, c)]  (Q[<([(x, c)]  s)>])) ↝«weakBisim» ([(x, c)]  (P[<([(x, c)]  s)>]))"
    by(blast intro: Weak_Early_Step_Sim.eqvtI Weak_Early_Bisim.eqvt)+

  hence "([(x, c)]  P)[<s>] ↝«weakBisim» ([(x, c)]  Q)[<s>]" and
        "([(x, c)]  Q)[<s>] ↝«weakBisim» ([(x, c)]  P)[<s>]" by simp+

  with cFreshs have "(c>([(x, c)]  P))[<s>] ↝«weakBisim» (c>([(x, c)]  Q))[<s>]" and
                    "(c>([(x, c)]  Q))[<s>] ↝«weakBisim» (c>([(x, c)]  P))[<s>]"
    by(blast intro: Goal)+

  moreover from cFreshP cFreshQ have "x>P = c>([(x, c)]  P)" and "x>Q = c>([(x, c)]  Q)"
    by(simp add: alphaRes)+

  ultimately show "(x>P)[<s>]  (x>Q)[<s>]"
    by(simp add: weakCongruence_def)
qed

lemma bangPres:
  fixes P :: pi
  and   Q :: pi
  
  assumes "P s Q"

  shows "!P s !Q"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.bangPres)

end

Theory Strong_Late_Expansion_Law

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Expansion_Law
  imports Strong_Late_Bisim_SC
begin

nominal_primrec summands :: "pi  pi set" where 
  "summands 𝟬 = {}"
| "summands (τ.(P)) = {τ.(P)}"
| "x  a  summands (a<x>.P) = {a<x>.P}"
| "summands (a{b}.P) = {a{b}.P}"
| "summands ([ab]P) = {}"
| "summands ([ab]P) = {}"
| "summands (P  Q) = (summands P)  (summands Q)"
| "summands (P  Q) = {}"
| "summands (x>P) = (if (a P'. a  x  P = a{x}.P') then ({x>P}) else {})"
| "summands (!P) = {}"
apply(auto simp add: fresh_singleton name_fresh_abs fresh_set_empty fresh_singleton pi.fresh)
apply(finite_guess)+
by(fresh_guess)+

lemma summandsInput[simp]:
  fixes a :: name
  and   x :: name
  and   P :: pi

  shows "summands (a<x>.P) = {a<x>.P}"
proof -
  obtain y where yineqa: "y  a" and yFreshP: "y  P"
    by(force intro: name_exists_fresh[of "(a, P)"] simp add: fresh_prod)
  from yFreshP have "a<x>.P = a<y>.([(x, y)]  P)" by(simp add: alphaInput)
  with yineqa show ?thesis by simp
qed

lemma finiteSummands:
  fixes P :: pi
  
  shows "finite(summands P)"
by(induct P rule: pi.induct) auto

lemma boundSummandDest[dest]:
  fixes x  :: name
  and   y  :: name
  and   P' :: pi
  and   P  :: pi

  assumes "x>x{y}.P'  summands P"
  
  shows False
using assms
by(induct P rule: pi.induct, auto simp add: if_split pi.inject name_abs_eq name_calc)

lemma summandFresh:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "P  summands Q"
  and     "x  Q"
  
  shows "x  P"
using assms
by(nominal_induct Q avoiding: P rule: pi.strong_induct, auto simp add: if_split)

nominal_primrec hnf :: "pi  bool" where
  "hnf 𝟬 = True"
| "hnf (τ.(P)) = True"
| "x  a  hnf (a<x>.P) = True"
| "hnf (a{b}.P) = True"
| "hnf ([ab]P) = False"
| "hnf ([ab]P) = False"
| "hnf (P  Q) = ((hnf P)  (hnf Q)  P  𝟬  Q  𝟬)"
| "hnf (P  Q) = False"
| "hnf (x>P) = (a P'. a  x  P = a{x}.P')"
| "hnf (!P) = False"
apply(auto simp add: fresh_bool)
apply(finite_guess)+
by(fresh_guess)+

lemma hnfInput[simp]:
  fixes a :: name
  and   x :: name
  and   P :: pi

  shows "hnf (a<x>.P)"
proof -
  obtain y where yineqa: "y  a" and yFreshP: "y  P"
    by(force intro: name_exists_fresh[of "(a, P)"] simp add: fresh_prod)
  from yFreshP have "a<x>.P = a<y>.([(x, y)]  P)" by(simp add: alphaInput)
  with yineqa show ?thesis by simp
qed

lemma summandTransition:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   b  :: name
  and   P' :: pi

  assumes "hnf P"

  shows "P τ  P' = (τ.(P')  summands P)"
  and   "P a<x>  P' = (a<x>.P'  summands P)"
  and   "P a[b]  P' = (a{b}.P'  summands P)"
  and   "a  x  P ax>  P' = (x>a{x}.P'  summands P)"
proof -
  from assms show "P τ  P' = (τ.(P')  summands P)"
  proof(induct P rule: pi.induct)
    case PiNil
    show ?case by auto
  next
    case(Output a b P)
    show ?case by auto
  next
    case(Tau P)
    have "τ.(P) τ  P'  τ.(P')  summands (τ.(P))"
      by(auto elim: tauCases simp add: pi.inject residual.inject)
    moreover have "τ.(P')  summands (τ.(P))  τ.(P) τ  P'"
      by(auto simp add: pi.inject intro: transitions.Tau)
    ultimately show ?case by blast
  next
    case(Input a x P)
    show ?case by auto
  next
    case(Match a b P)
    have "hnf ([ab]P)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Mismatch a b P)
    have "hnf ([ab]P)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Sum P Q) 
    have "hnf (P  Q)" by fact
    hence Phnf: "hnf P" and Qhnf: "hnf Q" by simp+
    
    have IHP: "P τ  P' = (τ.(P')  summands P)"
    proof -
      have "hnf P  P τ  P' = (τ.(P')  summands P)" by fact
      with Phnf show ?thesis by simp
    qed
    
    have IHQ: "Q τ  P' = (τ.(P')  summands Q)"
    proof -
      have "hnf Q  Q τ  P' = (τ.(P')  summands Q)" by fact
      with Qhnf show ?thesis by simp
    qed

    from IHP IHQ have "P  Q τ  P'  τ.(P')  summands (P  Q)"
      by(erule_tac sumCases, auto)
    moreover from IHP IHQ have "τ.(P')  summands (P  Q)  P  Q τ  P'"
      by(auto dest: Sum1 Sum2)
    ultimately show ?case by blast
  next
    case(Par P Q)
    have "hnf (P  Q)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Res x P)
    thus ?case by(auto elim: resCasesF)
  next
    case(Bang P)
    have "hnf (!P)" by fact
    hence False by simp
    thus ?case by simp
  qed
next
  from assms show "P a<x>  P' = (a<x>.P'  summands P)"
  proof(induct P rule: pi.induct)
    case PiNil
    show ?case by auto
  next
    case(Output c b P)
    show ?case by auto
  next
    case(Tau P)
    show ?case by auto
  next
    case(Input b y P)
    have "b<y>.P a<x>  P'  a<x>.P'  summands (b<y>.P)"
      by(auto elim: inputCases' simp add: pi.inject residual.inject)
    moreover have "a<x>.P'  summands (b<y>.P)  b<y>.P a<x>  P'"
      apply(auto simp add: pi.inject name_abs_eq intro: Late_Semantics.Input)
      apply(subgoal_tac "b<x>  [(x, y)]  P = (b<y>  [(x, y)]  [(x, y)]  P)")
      apply(auto intro: Late_Semantics.Input)
      by(simp add: alphaBoundResidual name_swap)
    ultimately show ?case by blast
  next
    case(Match a b P)
    have "hnf ([ab]P)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Mismatch a b P)
    have "hnf ([ab]P)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Sum P Q) 
    have "hnf (P  Q)" by fact
    hence Phnf: "hnf P" and Qhnf: "hnf Q" by simp+
    
    have IHP: "P a<x>  P' = (a<x>.P'  summands P)"
    proof -
      have "hnf P  P a<x>  P' = (a<x>.P'  summands P)" by fact
      with Phnf show ?thesis by simp
    qed
    
    have IHQ: "Q a<x>  P' = (a<x>.P'  summands Q)"
    proof -
      have "hnf Q  Q a<x>  P' = (a<x>.P'  summands Q)" by fact
      with Qhnf show ?thesis by simp
    qed

    from IHP IHQ have "P  Q a<x>  P'  a<x>.P'  summands (P  Q)"
      by(erule_tac sumCases, auto)
    moreover from IHP IHQ have "a<x>.P'  summands (P  Q)  P  Q a<x>  P'"
      by(auto dest: Sum1 Sum2)
    ultimately show ?case by blast
  next
    case(Par P Q)
    have "hnf (P  Q)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Res y P)
    have "hnf(y>P)" by fact
    thus ?case by(auto simp add: if_split)
  next
    case(Bang P)
    have "hnf (!P)" by fact
    hence False by simp
    thus ?case by simp
  qed
next
  from assms show "P a[b]  P' = (a{b}.P'  summands P)"
  proof(induct P rule: pi.induct)
    case PiNil
    show ?case by auto
  next
    case(Output c d P)
    have "c{d}.P a[b]  P'  a{b}.P'  summands (c{d}.P)"
      by(auto elim: outputCases simp add: residual.inject pi.inject)
    moreover have "a{b}.P'  summands (c{d}.P)  c{d}.P a[b]  P'"
      by(auto simp add: pi.inject intro: transitions.Output)
    ultimately show ?case by blast
  next
    case(Tau P)
    show ?case by auto
  next
    case(Input c x P)
    show ?case by auto
  next
    case(Match a b P)
    have "hnf ([ab]P)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Mismatch a b P)
    have "hnf ([ab]P)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Sum P Q) 
    have "hnf (P  Q)" by fact
    hence Phnf: "hnf P" and Qhnf: "hnf Q" by simp+
    
    have IHP: "P a[b]  P' = (a{b}.P'  summands P)"
    proof -
      have "hnf P  P a[b]  P' = (a{b}.P'  summands P)" by fact
      with Phnf show ?thesis by simp
    qed
    
    have IHQ: "Q a[b]  P' = (a{b}.P'  summands Q)"
    proof -
      have "hnf Q  Q a[b]  P' = (a{b}.P'  summands Q)" by fact
      with Qhnf show ?thesis by simp
    qed

    from IHP IHQ have "P  Q a[b]  P'  a{b}.P'  summands (P  Q)"
      by(erule_tac sumCases, auto)
    moreover from IHP IHQ have "a{b}.P'  summands (P  Q)  P  Q a[b]  P'"
      by(auto dest: Sum1 Sum2)
    ultimately show ?case by blast
  next
    case(Par P Q)
    have "hnf (P  Q)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Res x P)
    have "hnf (x>P)" by fact
    thus ?case by(force elim: resCasesF outputCases simp add: if_split residual.inject)
  next
    case(Bang P)
    have "hnf (!P)" by fact
    hence False by simp
    thus ?case by simp
  qed
next
  assume "ax"
  with assms show "P ax>  P' = (x>a{x}.P'  summands P)"
  proof(nominal_induct P avoiding: x P' rule: pi.strong_induct)
    case PiNil
    show ?case by auto
  next
    case(Output a b P)
    show ?case by auto 
  next
    case(Tau P)
    show ?case by auto
  next
    case(Input a x P)
    show ?case by auto
  next
    case(Match a b P)
    have "hnf ([ab]P)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Mismatch a b P)
    have "hnf ([ab]P)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Sum P Q) 
    have "hnf (P  Q)" by fact
    hence Phnf: "hnf P" and Qhnf: "hnf Q" by simp+
    have aineqx: "a  x" by fact

    have IHP: "P ax>  P' = (x>a{x}.P'  summands P)"
    proof -
      have "x P'. hnf P; a  x  P ax>  P' = (x>a{x}.P'  summands P)" by fact
      with Phnf aineqx show ?thesis by simp
    qed
    
    have IHQ: "Q ax>  P' = (x>a{x}.P'  summands Q)"
    proof -
      have "x Q'. hnf Q; a  x  Q ax>  P' = (x>a{x}.P'  summands Q)" by fact
      with Qhnf aineqx show ?thesis by simp
    qed

    from IHP IHQ have "P  Q ax>  P'  x>a{x}.P'  summands (P  Q)"
      by(erule_tac sumCases, auto)
    moreover from IHP IHQ have "x>a{x}.P'  summands (P  Q)  P  Q ax>  P'"
      by(auto dest: Sum1 Sum2)
    ultimately show ?case by blast
  next
    case(Par P Q)
    have "hnf (P  Q)" by fact
    hence False by simp
    thus ?case by simp
  next
    case(Res y P)
    have Phnf: "hnf (y>P)" by fact
    then obtain b P'' where bineqy: "b  y" and PeqP'': "P = b{y}.P''"
      by auto
    have "y  x" by fact hence xineqy:  "x  y" by simp
    have yFreshP': "y  P'" by fact
    have aineqx: "ax" by fact
    have "y>P ax>  P'  (x>a{x}.P'  summands (y>P))"
    proof -
      assume Trans: "y>P ax>  P'"
      hence  aeqb: "a = b" using xineqy bineqy PeqP''
        by(induct rule: resCasesB', auto elim: outputCases simp add: residual.inject alpha' abs_fresh pi.inject)

      have Goal: "x P'. y>b{y}.P'' bx>  P'; x  y; x  b; x  P'' 
                           x>b{x}.P'  summands(y>b{y}.P'')"
      proof -
        fix x P'
        assume xFreshP'': "(x::name)  P''" and xineqb: "x  b"
        assume "y>b{y}.P'' bx>  P'" and xineqy: "x  y"
        moreover from x  b x  P'' x  y have "x  b{y}.P''" by simp
        ultimately show "x>b{x}.P'  summands (y>b{y}.P'')"
        proof(induct rule: resCasesB)
          case(cOpen a P''')
          have "BoundOutputS b = BoundOutputS a" by fact hence beqa: "b = a" by simp
          have Trans: "b{y}.P'' a[y]  P'''" by fact
          with PeqP'' have P''eqP''': "P'' = P'''"
            by(force elim: outputCases simp add: residual.inject)
          with bineqy xineqy xFreshP'' have "y  b{x}.([(x, y)]  P''')"
            by(simp add: name_fresh_abs name_calc name_fresh_left)
          with bineqy Phnf PeqP'' P''eqP''' xineqb show ?case 
            by(simp only: alphaRes, simp add: name_calc)
        next
          case(cRes P''')
          have "b{y}.P'' bx>  P'''" by fact
          hence False by auto
          thus ?case by simp
        qed     
      qed
      obtain z where zineqx: "z  x" and zineqy: "z  y" and zFreshP'': "z  P''" 
                 and zineqb: "z  b" and zFreshP': "z  P'"
        by(force intro: name_exists_fresh[of "(x, y, b, P'', P')"] simp add: fresh_prod)

      from zFreshP' aeqb PeqP'' Trans have Trans': "y>b{y}.P'' bz>  [(z, x)]  P'"
        by(simp add: alphaBoundResidual name_swap)
      hence "z>b{z}.([(z, x)]  P')  summands (y>b{y}.P'')" using zineqy zineqb zFreshP''
        by(rule Goal)
      moreover from bineqy zineqx zFreshP' aineqx aeqb have "x  b{z}.([(z, x)]  P')"
        by(simp add: name_fresh_left name_calc)
      ultimately have "x>b{x}.P'  summands (y>b{y}.P'')" using zineqb
        by(simp add: alphaRes name_calc)
      with aeqb PeqP'' show ?thesis by blast
    qed
    moreover have "x>a{x}.P'  summands(y>P)  y>P ax>  P'"
    proof -
      assume "x>a{x}.P'  summands(y>P)"
      with PeqP'' have Summ: "x>a{x}.P'  summands(y>b{y}.P'')" by simp
      moreover with bineqy xineqy have aeqb: "a = b" 
        by(auto simp add: if_split pi.inject name_abs_eq name_fresh_fresh)
      from bineqy xineqy yFreshP' have "y  b{x}.P'" by(simp add: name_calc)
      with Summ aeqb bineqy aineqx have "y>b{y}.([(x, y)]  P')  summands(y>b{y}.P'')"
        by(simp only: alphaRes, simp add: name_calc)
      with aeqb PeqP'' have "y>P ay>  [(x, y)]  P'"
        by(auto intro: Open Output simp add: if_split pi.inject name_abs_eq)
      moreover from yFreshP' have "x  [(x, y)]  P'" by(simp add: name_fresh_left name_calc)
      ultimately show ?thesis by(simp add: alphaBoundResidual name_swap)
    qed
    ultimately show ?case by blast
  next
    case(Bang P)
    have "hnf (!P)" by fact
    hence False by simp
    thus ?case by simp
  qed
qed

definition "expandSet" :: "pi  pi  pi set" where
          "expandSet P Q  {τ.(P'  Q) | P'. τ.(P')  summands P}  
                           {τ.(P  Q') | Q'. τ.(Q')  summands Q}  
                           {a{b}.(P'  Q) | a b P'. a{b}.P'  summands P} 
                           {a{b}.(P  Q') | a b Q'. a{b}.Q'  summands Q} 
                           {a<x>.(P'  Q) | a x P'. a<x>.P'  summands P  x  Q} 
                           {a<x>.(P  Q') | a x Q'. a<x>.Q'  summands Q  x  P} 
                           {x>a{x}.(P'  Q) | a x P'. x>a{x}.P'  summands P  x  Q}  
                           {x>a{x}.(P  Q') | a x Q'. x>a{x}.Q'  summands Q  x  P}  
                           {τ.(P'[x::=b]  Q') | x P' b Q'. a. a<x>.P'  summands P  a{b}.Q'  summands Q}  
                           {τ.(P'  (Q'[x::=b])) | b P' x Q'. a. a{b}.P'  summands P  a<x>.Q'  summands Q}  
                           {τ.(y>(P'[x::=y]  Q')) | x P' y Q'. a. a<x>.P'  summands P  y>a{y}.Q'  summands Q  y  P} 
                           {τ.(y>(P'  (Q'[x::=y]))) | y P' x Q'. a. y>a{y}.P'  summands P  a<x>.Q'  summands Q  y  Q}"

lemma finiteExpand:
  fixes P :: pi
  and   Q :: pi

  shows "finite(expandSet P Q)"
proof -
  have "finite {τ.(P'  Q) | P'. τ.(P')  summands P}"
    by(induct P rule: pi.induct, auto simp add: pi.inject Collect_ex_eq conj_disj_distribL
                                                           Collect_disj_eq UN_Un_distrib)
  moreover have "finite {τ.(P  Q') | Q'. τ.(Q')  summands Q}"
    by(induct Q rule: pi.induct, auto simp add: pi.inject Collect_ex_eq conj_disj_distribL
                                                           Collect_disj_eq UN_Un_distrib)
  moreover have "finite {a{b}.(P'  Q) | a b P'. a{b}.P'  summands P}"
    by(induct P rule: pi.induct, auto simp add: pi.inject Collect_ex_eq conj_disj_distribL
                                                           Collect_disj_eq UN_Un_distrib)
  moreover have "finite {a{b}.(P  Q') | a b Q'. a{b}.Q'  summands Q}"
    by(induct Q rule: pi.induct, auto simp add: pi.inject Collect_ex_eq conj_disj_distribL
                                                           Collect_disj_eq UN_Un_distrib)
  moreover have "finite {a<x>.(P'  Q) | a x P'. a<x>.P'  summands P  x  Q}"
  proof -
    have Aux: "a x P Q. (x::name)  Q  {a'<x'>.(P'  Q) |a' x' P'. a'<x'>.P' = a<x>.P  x'  Q} = {a<x>.(P  Q)}"
      by(auto simp add: pi.inject name_abs_eq name_fresh_fresh)
    thus ?thesis
      by(nominal_induct P avoiding: Q rule: pi.strong_induct,
         auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
                        Collect_disj_eq UN_Un_distrib)
  qed
  moreover have "finite {a<x>.(P  Q') | a x Q'. a<x>.Q'  summands Q  x  P}"
  proof -
    have Aux: "a x P Q. (x::name)  P  {a'<x'>.(P  Q') |a' x' Q'. a'<x'>.Q' = a<x>.Q  x'  P} = {a<x>.(P  Q)}"
      by(auto simp add: pi.inject name_abs_eq name_fresh_fresh)
    thus ?thesis
      by(nominal_induct Q avoiding: P rule: pi.strong_induct,
         auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
                        Collect_disj_eq UN_Un_distrib)
  qed
  moreover have "finite {x>a{x}.(P'  Q) | a x P'. x>a{x}.P'  summands P  x  Q}"
  proof -
    have Aux: "a x P Q. x  Q; a  x  {x'>a'{x'}.(P'  Q) |a' x' P'. x'>a'{x'}.P' = x>a{x}.P  x'  Q} = 
                                             {x>a{x}.(P  Q)}"
      by(auto simp add: pi.inject name_abs_eq name_fresh_fresh)
    thus ?thesis
      by(nominal_induct P avoiding: Q rule: pi.strong_induct, 
         auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
                        Collect_disj_eq UN_Un_distrib)
  qed
  moreover have "finite {x>a{x}.(P  Q') | a x Q'. x>a{x}.Q'  summands Q  x  P}"
  proof -
    have Aux: "a x P Q. x  P; a  x  {x'>a'{x'}.(P  Q') |a' x' Q'. x'>a'{x'}.Q' = x>a{x}.Q  x'  P} = 
                                             {x>a{x}.(P  Q)}"
      by(auto simp add: pi.inject name_abs_eq name_fresh_fresh)
    thus ?thesis
      by(nominal_induct Q avoiding: P rule: pi.strong_induct, 
         auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
                        Collect_disj_eq UN_Un_distrib)
  qed
  moreover have "finite {τ.(P'[x::=b]  Q') | x P' b Q'. a. a<x>.P'  summands P  a{b}.Q'  summands Q}"
  proof -
    have Aux: "a x P b Q. {τ.(P'[x'::=b']  Q') | a' x' P' b' Q'. a'<x'>.P' = a<x>.P  a'{b'}.Q' = a{b}.Q} = {τ.(P[x::=b]  Q)}"
      by(auto simp add: name_abs_eq pi.inject renaming)
    have "a x P Q b::'a::{}. finite {τ.(P'[x'::=b]  Q') | a' x' P' b Q'. a'<x'>.P' = a<x>.P  a'{b}.Q'  summands Q}"
      apply(induct rule: pi.induct, simp_all)
      apply(case_tac "a=name1")
      apply(simp add: Aux)
      apply(simp add: pi.inject)
      by(simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
                   Collect_disj_eq UN_Un_distrib)
    hence "finite {τ.(P'[x::=b]  Q') | a x P' b Q'. a<x>.P'  summands P  a{b}.Q'  summands Q}"
      by(nominal_induct P avoiding: Q rule: pi.strong_induct,
         auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
                        Collect_disj_eq UN_Un_distrib name_abs_eq)
    thus ?thesis 
      apply(rule_tac finite_subset)
      defer
      by blast+
  qed
  moreover have "finite {τ.(P'  (Q'[x::=b])) | b P' x Q'. a. a{b}.P'  summands P  a<x>.Q'  summands Q}"
  proof -
      have Aux: "a x P b Q. {τ.(P'  (Q'[x'::=b'])) | a' b' P' x' Q'. a'{b'}.P' = a{b}.P  a'<x'>.Q' = a<x>.Q} = {τ.(P  (Q[x::=b]))}"
        by(auto simp add: name_abs_eq pi.inject renaming)
      have "a b P Q x::'a::{}. finite {τ.(P'  (Q'[x::=b'])) | a' b' P' x Q'. a'{b'}.P' = a{b}.P  a'<x>.Q'  summands Q}"
      apply(induct rule: pi.induct, simp_all)
      apply(case_tac "a=name1")
      apply(simp add: Aux)
      apply(simp add: pi.inject)
      by(simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
                     Collect_disj_eq UN_Un_distrib)
    hence "finite {τ.(P'  (Q'[x::=b])) | a b P' x Q'. a{b}.P'  summands P  a<x>.Q'  summands Q}"
      by(nominal_induct P avoiding: Q rule: pi.strong_induct,
         auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
                        Collect_disj_eq UN_Un_distrib name_abs_eq)
    thus ?thesis
      apply(rule_tac finite_subset) defer by blast+
  qed
  moreover have "finite {τ.(y>(P'[x::=y]  Q')) | x P' y Q'. a. a<x>.P'  summands P  y>a{y}.Q'  summands Q  y  P}"
  proof -
    have Aux: "a x P y Q. y  P  y  a  {τ.(y'>(P'[x'::=y']  Q')) | a' x' P' y' Q'. a'<x'>.P' = a<x>.P  y'>a'{y'}.Q' = y>a{y}.Q  y'  a<x>.P} = {τ.(y>(P[x::=y]  Q))}"
      apply(auto simp add: pi.inject name_abs_eq name_fresh_abs name_calc fresh_fact2 fresh_fact1 eqvts forget)
      apply(subst name_swap, simp add: injPermSubst fresh_fact1 fresh_fact2)+
      by(simp add: name_swap injPermSubst)+

    have BC: "a x P Q. finite {τ.(y>(P'[x'::=y]  Q')) | a' x' P' y Q'. a'<x'>.P' = a<x>.P  y>a'{y}.Q'  summands Q  y  a<x>.P}"
    proof -
      fix a x P Q
      show "finite {τ.(y>(P'[x'::=y]  Q')) | a' x' P' y Q'. a'<x'>.P' = a<x>.P  y>a'{y}.Q'  summands Q  y  a<x>.P}"
        apply(nominal_induct Q avoiding: a P rule: pi.strong_induct, simp_all)
        apply(simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
                        Collect_disj_eq UN_Un_distrib)
        apply(clarsimp)
        apply(case_tac "a=aa")
        apply(insert Aux, auto)
        by(simp add: pi.inject name_abs_eq name_calc)
    qed

    have IH: "P P' Q. {τ.(y>(P''[x::=y]  Q')) | a x P'' y Q'. (a<x>.P''  summands P  a<x>.P''  summands P')  y>a{y}.Q'  summands Q  y  P  y  P'} = {τ.(y>(P''[x::=y]  Q')) | a x P'' y Q'. a<x>.P''  summands P  y>a{y}.Q'  summands Q  y  P  y  P'}  {τ.(y>(P''[x::=y]  Q')) | a x P'' y Q'. a<x>.P''  summands P'  y>a{y}.Q'  summands Q  y  P  y  P'}"
      by blast
    have IH': "P Q P'. {τ.(y>(P''[x::=y]  Q')) | a x P'' y Q'. a<x>.P''  summands P  y>a{y}.Q'  summands Q  y  P  y  P'}  {τ.(y>(P''[x::=y]  Q')) | a x P'' y Q'. a<x>.P''  summands P  y>a{y}.Q'  summands Q  y  P}"
      by blast
    have IH'': "P Q P'. {τ.(y>(P''[x::=y]  Q')) | a x P'' y Q'. a<x>.P''  summands P'  y>a{y}.Q'  summands Q  y  P  y  P'}  {τ.(y>(P''[x::=y]  Q')) | a x P'' y Q'. a<x>.P''  summands P'  y>a{y}.Q'  summands Q  y  P'}"
      by blast
    have "finite {τ.(y>(P'[x::=y]  Q')) | a x P' y Q'. a<x>.P'  summands P  y>a{y}.Q'  summands Q  y  P}"
      apply(nominal_induct P avoiding: Q rule: pi.strong_induct, simp_all)
      apply(insert BC, force)
      apply(insert IH, auto)
      apply(blast intro: finite_subset[OF IH'])
      by(blast intro: finite_subset[OF IH''])
    thus ?thesis
      apply(rule_tac finite_subset) defer by(blast)+
  qed
  moreover have "finite {τ.(y>(P'  (Q'[x::=y]))) | y P' x Q'. a. y>a{y}.P'  summands P  a<x>.Q'  summands Q  y  Q}"
  proof -
    have Aux: "a y P x Q. y  Q; y  a  {τ.(y'>(P'  (Q'[x'::=y']))) | a' y' P' x' Q'. y'>a'{y'}.P' = y>a{y}.P  a'<x'>.Q' = a<x>.Q  y'  a<x>.Q} = {τ.(y>(P  (Q[x::=y])))}"
      apply(auto simp add: pi.inject name_abs_eq name_fresh_abs name_calc fresh_fact2 fresh_fact1 forget eqvts fresh_left renaming[symmetric])
      apply(subst name_swap, simp add: injPermSubst fresh_fact1 fresh_fact2)+
      by(simp add: name_swap injPermSubst)+

    have IH: "P y a Q Q'. {τ.(y'>(P'  (Q''[x::=y']))) | a' y' P' x Q''. y'>a'{y'}.P' = y>a{y}.P  (a'<x>.Q''  summands Q  a'<x>.Q''  summands Q')  y'  Q  y'  Q'} = {τ.(y'>(P'  (Q''[x::=y']))) | a' y' P' x Q''. y'>a'{y'}.P' = y>a{y}.P  a'<x>.Q''  summands Q  y'  Q  y'  Q'}  {τ.(y'>(P'  (Q''[x::=y']))) | a' y' P' x Q''. y'>a'{y'}.P' = y>a{y}.P  a'<x>.Q''  summands Q'  y'  Q  y'  Q'}"
      by blast
    have IH': "a y P Q Q'. {τ.(y'>(P'  (Q''[x::=y']))) | a' y' P' x Q''. y'>a'{y'}.P' = y>a{y}.P  a'<x>.Q''  summands Q  y'  Q  y'  Q'}  {τ.(y'>(P'  (Q''[x::=y']))) | a' y' P' x Q''. y'>a'{y'}.P' = y>a{y}.P  a'<x>.Q''  summands Q  y'  Q}"
      by blast
    have IH'': "a y P Q Q'. {τ.(y'>(P'  (Q''[x::=y']))) | a' y' P' x Q''. y'>a'{y'}.P' = y>a{y}.P  a'<x>.Q''  summands Q'  y'  Q  y'  Q'}  {τ.(y'>(P'  (Q''[x::=y']))) | a' y' P' x Q''. y'>a'{y'}.P' = y>a{y}.P  a'<x>.Q''  summands Q'  y'  Q'}"
      by blast

    have BC: "a y P Q. y  Q; y  a  finite {τ.(y'>(P'  (Q'[x::=y']))) | a' y' P' x Q'. y'>a'{y'}.P' = y>a{y}.P  a'<x>.Q'  summands Q  y'  Q}"
    proof -
      fix a y P Q
      assume "(y::name)  (Q::pi)" and "y  a"
      thus "finite {τ.(y'>(P'  (Q'[x::=y']))) | a' y' P' x Q'. y'>a'{y'}.P' = y>a{y}.P  a'<x>.Q'  summands Q  y'  Q}"
        apply(nominal_induct Q avoiding: y rule: pi.strong_induct, simp_all)
        apply(case_tac "a=name1")
        apply auto
        apply(subgoal_tac "ya  (pi::pi)")
        apply(insert Aux)
        apply auto
        apply(simp add: name_fresh_abs)
        apply(simp add: pi.inject name_abs_eq name_calc)
        apply(insert IH)
        apply auto
        apply(blast intro: finite_subset[OF IH'])
        by(blast intro: finite_subset[OF IH''])
    qed
    have "finite {τ.(y>(P'  (Q'[x::=y]))) | a y P' x Q'. y>a{y}.P'  summands P  a<x>.Q'  summands Q  y  Q}"

      apply(nominal_induct P avoiding: Q rule: pi.strong_induct, simp_all)
      apply(simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR name_fresh_abs
                      Collect_disj_eq UN_Un_distrib)
      by(auto intro: BC)
    thus ?thesis
      apply(rule_tac finite_subset) defer by blast+
  qed

  ultimately show ?thesis
    by(simp add: expandSet_def)
qed

lemma expandHnf:
  fixes P :: pi
  and   Q :: pi

  shows "R  (expandSet P Q). hnf R"
by(force simp add: expandSet_def)

inductive_set sumComposeSet :: "(pi × pi set) set"
where
  empty:  "(𝟬, {})  sumComposeSet"
| insert: "Q  S; (P, S - {Q})  sumComposeSet  (P  Q, S)  sumComposeSet"

lemma expandAction:
  fixes P :: pi
  and   Q :: pi
  and   S :: "pi set"

  assumes "(P, S)  sumComposeSet"
  and     "Q  S"
  and     "Q  Rs"

  shows "P  Rs"
using assms
proof(induct arbitrary: Q rule: sumComposeSet.induct)
  case empty
  have "Q  {}" by fact
  hence False by simp
  thus ?case by simp
next
  case(insert Q' S P Q)
  have QTrans: "Q  Rs" by fact
  show ?case
  proof(case_tac "Q = Q'")
    assume "Q = Q'"
    with QTrans show "P  Q'  Rs" by(blast intro: Sum2)
  next
    assume QineqQ': "Q  Q'"
    have IH: "Q. Q  S - {Q'}; Q  Rs  P  Rs" by fact
    have QinS: "Q  S" by fact
    with QineqQ' have "Q  S - {Q'}" by simp
    hence "P  Rs" using QTrans by(rule IH)
    thus ?case by(rule Sum1)
  qed
qed

lemma expandAction':
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "(R, S)  sumComposeSet"
  and     "R  Rs"

  shows "P  S. P  Rs"
using assms
proof(induct rule: sumComposeSet.induct)
  case empty
  have "𝟬  Rs" by fact
  hence False by blast
  thus ?case by simp
next
  case(insert Q S P)
  have QinS: "Q  S" by fact
  have "P  Q  Rs" by fact
  thus ?case
  proof(induct rule: sumCases)
    case cSum1
    have "P  Rs" by fact
    moreover have "P  Rs  P  (S - {Q}). P  Rs" by fact
    ultimately obtain P where PinS: "P  (S - {Q})" and PTrans: "P  Rs" by blast
    show ?case
    proof(case_tac "P = Q")
      assume "P = Q"
      with PTrans QinS show ?case by blast
    next
      assume PineqQ: "P  Q"
      from PinS have "P  S" by simp
      with PTrans show ?thesis by blast
    qed
  next
    case cSum2
    have "Q  Rs" by fact
    with QinS show ?case by blast
  qed
qed

lemma expandTrans:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  and   a :: name
  and   b :: name
  and   x :: name

  assumes Exp: "(R, expandSet P Q)  sumComposeSet"
  and     Phnf: "hnf P"
  and     Qhnf: "hnf Q"

  shows "(P  Q τ  P') = (R τ  P')"
  and   "(P  Q a[b]  P') = (R a[b]  P')"
  and   "(P  Q a<x>  P') = (R a<x>  P')"
  and   "(P  Q ax>  P') = (R ax>  P')"
proof -
  show "P  Q  τ  P' = R  τ  P'"
  proof(rule iffI)
    assume "P  Q τ  P'"
    thus "R τ  P'"
    proof(induct rule: parCasesF[of _ _ _ _ _ "(P, Q)"])
      case(cPar1 P')
      have "P τ  P'" by fact
      with Phnf have "τ.(P')  summands P" by(simp add: summandTransition)
      hence "τ.(P'  Q)  expandSet P Q" by(auto simp add: expandSet_def)
      moreover have "τ.(P'  Q) τ  (P'  Q)" by(rule Tau)
      ultimately show ?case using Exp by(blast intro: expandAction)
    next
      case(cPar2 Q')
      have "Q τ  Q'" by fact
      with Qhnf have "τ.(Q')  summands Q" by(simp add: summandTransition)
      hence "τ.(P  Q')  expandSet P Q" by(auto simp add: expandSet_def)
      moreover have "τ.(P  Q') τ  (P  Q')" by(rule Tau)
      ultimately show ?case using Exp by(blast intro: expandAction)
    next
      case(cComm1 P' Q' a b x)
      have "P a<x>  P'" and "Q a[b]  Q'" by fact+
      with Phnf Qhnf have "a<x>.P'  summands P" and "a{b}.Q'  summands Q" by(simp add: summandTransition)+
      hence "τ.(P'[x::=b]  Q')  expandSet P Q" by(simp add: expandSet_def, blast)
      moreover have "τ.(P'[x::=b]  Q') τ  (P'[x::=b]  Q')" by(rule Tau)
      ultimately show ?case using Exp by(blast intro: expandAction)
    next
      case(cComm2 P' Q' a b x)
      have "P a[b]  P'" and "Q a<x>  Q'" by fact+
      with Phnf Qhnf have "a{b}.P'  summands P" and "a<x>.Q'  summands Q" by(simp add: summandTransition)+
      hence "τ.(P'  (Q'[x::=b]))  expandSet P Q" by(simp add: expandSet_def, blast)
      moreover have "τ.(P'  (Q'[x::=b])) τ  (P'  (Q'[x::=b]))" by(rule Tau)
      ultimately show ?case using Exp by(blast intro: expandAction)
    next
      case(cClose1 P' Q' a x y)
      have "y  (P, Q)" by fact
      hence yFreshP: "y  P" by(simp add: fresh_prod)
      have PTrans: "P a<x>  P'" by fact
      with Phnf have PSumm: "a<x>.P'  summands P" by(simp add: summandTransition)
      have "Q ay>  Q'" by fact
      moreover from PTrans yFreshP have "y  a" by(force dest: freshBoundDerivative)
      ultimately have "y>a{y}.Q'  summands Q" using Qhnf by(simp add: summandTransition)
      with PSumm yFreshP have "τ.(y>(P'[x::=y]  Q'))  expandSet P Q"
        by(auto simp add: expandSet_def)
      moreover have "τ.(y>(P'[x::=y]  Q')) τ  y>(P'[x::=y]  Q')" by(rule Tau)
      ultimately show ?case using Exp by(blast intro: expandAction)
    next
      case(cClose2 P' Q' a x y)
      have "y  (P, Q)" by fact
      hence yFreshQ: "y  Q" by(simp add: fresh_prod)
      have QTrans: "Q a<x>  Q'" by fact
      with Qhnf have QSumm: "a<x>.Q'  summands Q" by(simp add: summandTransition)
      have "P ay>  P'" by fact
      moreover from QTrans yFreshQ have "y  a" by(force dest: freshBoundDerivative)
      ultimately have "y>a{y}.P'  summands P" using Phnf by(simp add: summandTransition)
      with QSumm yFreshQ have "τ.(y>(P'  (Q'[x::=y])))  expandSet P Q"
        by(simp add: expandSet_def, blast)
      moreover have "τ.(y>(P'  (Q'[x::=y]))) τ  y>(P'  (Q'[x::=y]))" by(rule Tau)
      ultimately show ?case using Exp by(blast intro: expandAction)
    qed
  next
    assume "R τ  P'"
    with Exp obtain R where "R  expandSet P Q" and "R τ  P'" by(blast dest: expandAction')
    thus "P  Q τ  P'"
    proof(auto simp add: expandSet_def)
      fix P''
      assume "τ.(P'')  summands P"
      with Phnf have "P τ  P''" by(simp add: summandTransition)
      hence PQTrans: "P  Q τ  P''  Q" by(rule Par1F)
      assume "τ.(P''  Q) τ  P'"
      hence "P' = P''  Q" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
      with PQTrans show ?thesis by simp
    next
      fix Q'
      assume "τ.(Q')  summands Q"
      with Qhnf have "Q τ  Q'" by(simp add: summandTransition)
      hence PQTrans: "P  Q τ  P  Q'" by(rule Par2F)
      assume "τ.(P  Q') τ  P'"
      hence "P' = P  Q'" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
      with PQTrans show ?thesis by simp
    next
      fix a x P'' b Q'
      assume "a<x>.P''  summands P" and "a{b}.Q'  summands Q"
      with Phnf Qhnf have "P a<x>  P''" and "Q a[b]  Q'" by(simp add: summandTransition)+
      hence PQTrans: "P  Q τ  P''[x::=b]  Q'" by(rule Comm1)
      assume "τ.(P''[x::=b]  Q') τ  P'"
      hence "P' = P''[x::=b]  Q'" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
      with PQTrans show ?thesis by simp
    next
      fix a b P'' x Q'
      assume "a{b}.P''  summands P" and "a<x>.Q'  summands Q"
      with Phnf Qhnf have "P a[b]  P''" and "Q a<x>  Q'" by(simp add: summandTransition)+
      hence PQTrans: "P  Q τ  P''  (Q'[x::=b])" by(rule Comm2)
      assume "τ.(P''  (Q'[x::=b])) τ  P'"
      hence "P' = P''  (Q'[x::=b])" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
      with PQTrans show ?thesis by simp
    next
      fix a x P'' y Q'
      assume yFreshP: "(y::name)  P"
      assume "a<x>.P''  summands P" 
      with Phnf have PTrans: "P a<x>  P''" by(simp add: summandTransition)
      assume "y>a{y}.Q'  summands Q"
      moreover from yFreshP PTrans have "y  a" by(force dest: freshBoundDerivative)
      ultimately have "Q ay>  Q'" using Qhnf by(simp add: summandTransition)
      with PTrans have PQTrans: "P  Q τ  y>(P''[x::=y]  Q')" using yFreshP by(rule Close1)
      assume "τ.(y>(P''[x::=y]  Q')) τ  P'"
      hence "P' = y>(P''[x::=y]  Q')" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
      with PQTrans show ?thesis by simp
    next
      fix a y P'' x Q'
      assume yFreshQ: "(y::name)  Q"
      assume "a<x>.Q'  summands Q" 
      with Qhnf have QTrans: "Q a<x>  Q'" by(simp add: summandTransition)
      assume "y>a{y}.P''  summands P"
      moreover from yFreshQ QTrans have "y  a" by(force dest: freshBoundDerivative)
      ultimately have "P ay>  P''" using Phnf by(simp add: summandTransition)
      hence PQTrans: "P  Q τ  y>(P''  Q'[x::=y])" using QTrans yFreshQ by(rule Close2)
      assume "τ.(y>(P''  Q'[x::=y])) τ  P'"
      hence "P' = y>(P''  Q'[x::=y])" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
      with PQTrans show ?thesis by simp
    qed
  qed
next
  show "P  Q  a[b]  P' = R  a[b]  P'"
  proof(rule iffI)
    assume "P  Q a[b]  P'"
    thus "R a[b]  P'"
    proof(induct rule: parCasesF[where C="()"])
      case(cPar1 P')
      have "P a[b]  P'" by fact
      with Phnf have "a{b}.P'  summands P" by(simp add: summandTransition)
      hence "a{b}.(P'  Q)  expandSet P Q" by(auto simp add: expandSet_def)
      moreover have "a{b}.(P'  Q) a[b]  (P'  Q)" by(rule Output)
      ultimately show ?case using Exp by(blast intro: expandAction)
    next
      case(cPar2 Q')
      have "Q a[b]  Q'" by fact
      with Qhnf have "a{b}.Q'  summands Q" by(simp add: summandTransition)
      hence "a{b}.(P  Q')  expandSet P Q" by(simp add: expandSet_def, blast)
      moreover have "a{b}.(P  Q') a[b]  (P  Q')" by(rule Output)
      ultimately show ?case using Exp by(blast intro: expandAction)
    next 
      case cComm1
      thus ?case by auto
    next 
      case cComm2
      thus ?case by auto
    next 
      case cClose1
      thus ?case by auto
    next 
      case cClose2
      thus ?case by auto
    qed
  next
    assume "R a[b]  P'"
    with Exp obtain R where "R  expandSet P Q" and "R a[b]  P'" by(blast dest: expandAction')
    thus "P  Q a[b]  P'"
    proof(auto simp add: expandSet_def)
      fix a' b' P''
      assume "a'{b'}.P''  summands P"
      with Phnf have "P a'[b']  P''" by(simp add: summandTransition)
      hence PQTrans: "P  Q a'[b']  P''  Q" by(rule Par1F)
      assume "a'{b'}.(P''  Q) a[b]  P'"
      hence "P' = P''  Q" and "a = a'" and "b = b'"
        by(erule_tac outputCases, auto simp add: pi.inject residual.inject)+
      with PQTrans show ?thesis by simp
    next
      fix a' b' Q'
      assume "a'{b'}.Q'  summands Q"
      with Qhnf have "Q a'[b']  Q'" by(simp add: summandTransition)
      hence PQTrans: "P  Q a'[b']  P  Q'" by(rule Par2F)
      assume "a'{b'}.(P  Q') a[b]  P'"
      hence "P' = P  Q'" and "a = a'" and "b = b'"
        by(erule_tac outputCases, auto simp add: pi.inject residual.inject)+
      with PQTrans show ?thesis by simp
    qed
  qed
next
  show "P  Q  a<x>  P' = R  a<x>  P'"
  proof(rule iffI)
    {
      fix x P'
      assume "P  Q a<x>  P'" and "x  P" and "x  Q"
      hence "R a<x>  P'"
      proof(induct rule: parCasesB)
        case(cPar1 P')
        have "P a<x>  P'" by fact
        with Phnf have "a<x>.P'  summands P" by(simp add: summandTransition)
        moreover have "x  Q" by fact
        ultimately have "a<x>.(P'  Q)  expandSet P Q" by(auto simp add: expandSet_def)
        moreover have "a<x>.(P'  Q) a<x>  (P'  Q)" by(rule Input)
        ultimately show ?case using Exp by(blast intro: expandAction)
      next
        case(cPar2 Q')
        have "Q a<x>  Q'" by fact
        with Qhnf have "a<x>.Q'  summands Q" by(simp add: summandTransition)
        moreover have "x  P" by fact
        ultimately have "a<x>.(P  Q')  expandSet P Q" by(simp add: expandSet_def, blast)
        moreover have "a<x>.(P  Q') a<x>  (P  Q')" by(rule Input)
        ultimately show ?case using Exp by(blast intro: expandAction)
      qed
    }
    moreover obtain y::name where "y  P" and "y  Q" and "y  P'"
      by(generate_fresh "name") auto
    assume "P  Q a<x>  P'"
    with y  P' have "P  Q a<y>  ([(x, y)]  P')"
      by(simp add: alphaBoundResidual)
    ultimately have "R a<y>  ([(x, y)]  P')" using y  P y  Q
      by auto
    thus "R a<x>  P'" using y  P' by(simp add: alphaBoundResidual)
  next
    assume "R a<x>  P'"
    with Exp obtain R where "R  expandSet P Q" and "R a<x>  P'" by(blast dest: expandAction')
    thus "P  Q a<x>  P'"
    proof(auto simp add: expandSet_def)
      fix a' y P''
      assume "a'<y>.P''  summands P"
      with Phnf have "P a'<y>  P''" by(simp add: summandTransition)
      moreover assume "y  Q"
      ultimately have PQTrans: "P  Q a'<y>  P''  Q" by(rule Par1B)
      assume "a'<y>.(P''  Q) a<x>  P'"
      hence "a<x>  P' = a'<y>  P''  Q" and "a = a'"
        by(erule_tac inputCases', auto simp add: pi.inject residual.inject)+
      with PQTrans show ?thesis by simp
    next
      fix a' y Q'
      assume "a'<y>.Q'  summands Q"
      with Qhnf have "Q (a'::name)<y>  Q'" by(simp add: summandTransition)
      moreover assume "y  P"
      ultimately have PQTrans: "P  Q a'<y>  P  Q'" by(rule Par2B)
      assume "a'<y>.(P  Q') a<x>  P'"
      hence "a<x>  P' = a'<y>  P  Q'" and "a = a'"
        by(erule_tac inputCases', auto simp add: pi.inject residual.inject)+
      with PQTrans show ?thesis by simp
    qed
  qed
next
  have Goal: "P Q a x P' R. (R, expandSet P Q)  sumComposeSet; hnf P; hnf Q; a  x  P  Q ax>  P' = R ax>  P'"
  proof -
    fix P Q a x P' R
    assume aineqx: "(a::name)  x"
    assume Exp: "(R, expandSet P Q)  sumComposeSet"
    assume Phnf: "hnf P"
    assume Qhnf: "hnf Q"
    show "P  Q ax>  P' = R  ax>  P'"
    proof(rule iffI)
      {
        fix x P'
        assume "P  Q ax>  P'" and "x  P" and "x  Q" and "a  x"
        hence "R ax>  P'"
        proof(induct rule: parCasesB)
          case(cPar1 P')
          have "P ax>  P'" by fact
          with Phnf a  x have "x>a{x}.P'  summands P" by(simp add: summandTransition)
          moreover have "x  Q" by fact
          ultimately have "x>a{x}.(P'  Q)  expandSet P Q" by(auto simp add: expandSet_def)
          moreover have "x>a{x}.(P'  Q) ax>  (P'  Q)" using a  x
            by(blast intro: Open Output)
          ultimately show ?case using Exp by(blast intro: expandAction)
        next
          case(cPar2 Q')
          have "Q ax>  Q'" by fact
          with Qhnf a  x have "x>a{x}.Q'  summands Q" by(simp add: summandTransition)
          moreover have "x  P" by fact
          ultimately have "x>a{x}.(P  Q')  expandSet P Q" by(simp add: expandSet_def, blast)
          moreover have "x>a{x}.(P  Q') ax>  (P  Q')" using a  x
            by(blast intro: Open Output)
          ultimately show ?case using Exp by(blast intro: expandAction)
        qed
      }
      moreover obtain y::name where "y  P" and "y  Q" and "y  P'" and "y  a"
        by(generate_fresh "name") auto
      assume "P  Q ax>  P'"
      with y  P' have "P  Q ay>  ([(x, y)]  P')"
        by(simp add: alphaBoundResidual)
      ultimately have "R ay>  ([(x, y)]  P')" using y  P y  Q y  a
        by auto
      thus "R ax>  P'" using y  P' by(simp add: alphaBoundResidual)
    next
      {
        fix R x P'
        assume "R ax>  P'" and "R  expandSet P Q" and "x  R" and "x  P" and "x  Q"
        hence "P  Q ax>  P'" 
        proof(auto simp add: expandSet_def)
          fix a' y P''
          assume "y>a'{y}.P''  summands P"
          moreover hence "a'  y" by auto
          ultimately have "P a'y>  P''" using Phnf by(simp add: summandTransition)
          moreover assume "y  Q"
          ultimately have PQTrans: "P  Q a'y>  P''  Q" by(rule Par1B)
          assume ResTrans: "y>a'{y}.(P''  Q) ax>  P'" and "x  [y].a'{y}.(P''  Q)"
          with ResTrans a'  y x  P x  Q have "ax>  P' = a'y>  P''  Q"
            apply(case_tac "x=y")
            defer
            apply(erule_tac resCasesB)
            apply simp
            apply(simp add: abs_fresh)
            apply(auto simp add: residual.inject alpha' calc_atm fresh_left abs_fresh elim: outputCases)
            apply(ind_cases "y>a'{y}.(P''  Q)  ay>  P'")
            apply(simp add: pi.inject alpha' residual.inject abs_fresh eqvts calc_atm)
            apply(auto elim: outputCases)
            apply(simp add: pi.inject residual.inject alpha' calc_atm)
            apply auto
            apply(ind_cases "y>a'{y}.(P''  Q)  ay>  P'")
            apply(auto simp add: pi.inject alpha' residual.inject abs_fresh eqvts calc_atm)
            apply(auto elim: outputCases)
            apply(erule_tac outputCases)
            apply(auto simp add: freeRes.inject)
            apply hypsubst_thin
            apply(drule_tac pi="[(b, y)]" in pt_bij3)
            by simp
        with PQTrans show ?thesis by simp
      next
        fix a' y Q'
        assume "y>a'{y}.Q'  summands Q"
        moreover hence "a'  y" by auto
        ultimately have "Q a'y>  Q'" using Qhnf by(simp add: summandTransition)
        moreover assume "y  P"
        ultimately have PQTrans: "P  Q a'y>  P  Q'" by(rule Par2B)
        assume ResTrans: "y>a'{y}.(P  Q') ax>  P'" and "x  [y].a'{y}.(P  Q')"
        with ResTrans a'  y have "ax>  P' = a'y>  P  Q'"
          apply(case_tac "x=y")
          defer
          apply(erule_tac resCasesB)
            apply simp
            apply(simp add: abs_fresh)
            apply(auto simp add: residual.inject alpha' calc_atm fresh_left abs_fresh elim: outputCases)
            apply(ind_cases "y>a'{y}.(P  Q')  ay>  P'")
            apply(simp add: pi.inject alpha' residual.inject abs_fresh eqvts calc_atm)
            apply(auto elim: outputCases)
            apply(simp add: pi.inject residual.inject alpha' calc_atm)
            apply auto
            apply(ind_cases "y>a'{y}.(P  Q')  ay>  P'")
            apply(auto simp add: pi.inject alpha' residual.inject abs_fresh eqvts calc_atm)
            apply(auto elim: outputCases)
            apply(erule_tac outputCases)
            apply(auto simp add: freeRes.inject)
            apply hypsubst_thin
            apply(drule_tac pi="[(b, y)]" in pt_bij3)
            by simp
        with PQTrans show ?thesis by simp
      qed
    }
    moreover assume "R ax>  P'"
    with Exp obtain R where "R  expandSet P Q" and "R ax>  P'" 
      apply(drule_tac expandAction') by auto
    moreover obtain y::name where "y  P" and "y  Q" and "y  R" and "y  P'"
      by(generate_fresh "name") auto
    moreover with y  P' R ax>  P' have "R ay>  ([(x, y)]  P')" by(simp add: alphaBoundResidual)
    ultimately have "P  Q ay>  ([(x, y)]  P')" by auto
    thus "P  Q ax>  P'" using y  P' by(simp add: alphaBoundResidual)
    qed
  qed

  obtain y where yineqx: "a  y" and yFreshP': "y  P'"
    by(force intro: name_exists_fresh[of "(a, P')"] simp add: fresh_prod)
  from Exp Phnf Qhnf yineqx have "(P  Q ay>  [(x, y)]  P') = (R ay>  [(x, y)]  P')"
    by(rule Goal)
  moreover with yFreshP' have "x  [(x, y)]  P'" by(simp add: name_fresh_left name_calc)
  ultimately show "(P  Q ax>  P') = (R ax>  P')"
    by(simp add: alphaBoundResidual name_swap)
qed

lemma expandLeft:
  fixes P   :: pi
  and   Q   :: pi
  and   R   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Exp: "(R, expandSet P Q)  sumComposeSet"
  and     Phnf: "hnf P"
  and     Qhnf: "hnf Q"
  and     Id: "Id  Rel"

  shows "P  Q ↝[Rel] R"
proof(induct rule: simCases)
  case(Bound a x R')
  have "R a«x»  R'" by fact
  with Exp Phnf Qhnf have "P  Q a«x»  R'" by(cases a, auto simp add: expandTrans)
  moreover from Id have "derivative R' R' a x Rel" by(cases a, auto simp add: derivative_def)
  ultimately show ?case by blast
next
  case(Free α R')
  have "R α  R'" by fact
  with Exp Phnf Qhnf have "P  Q α  R'" by(cases α, auto simp add: expandTrans)
  moreover from Id have "(R', R')  Rel" by blast
  ultimately show ?case by blast
qed

lemma expandRight:
  fixes P   :: pi
  and   Q   :: pi
  and   R   :: pi
  and   Rel :: "(pi × pi) set"

  assumes Exp: "(R, expandSet P Q)  sumComposeSet"
  and     Phnf: "hnf P"
  and     Qhnf: "hnf Q"
  and     Id: "Id  Rel"

  shows "R ↝[Rel] P  Q"
proof(induct rule: simCases)
  case(Bound a x R')
  have "P  Q a«x»  R'" by fact
  with Exp Phnf Qhnf have "R a«x»  R'" by(cases a, auto simp add: expandTrans)
  moreover from Id have "derivative R' R' a x Rel" by(cases a, auto simp add: derivative_def)
  ultimately show ?case by blast
next
  case(Free α R')
  have "P  Q α  R'" by fact
  with Exp Phnf Qhnf have "R α  R'" by(cases α, auto simp add: expandTrans)
  moreover from Id have "(R', R')  Rel" by blast
  ultimately show ?case by blast
qed

lemma expandSC: 
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  assumes "(R, expandSet P Q)  sumComposeSet"
  and     "hnf P"
  and     "hnf Q"

  shows "P  Q  R"
proof -
  let ?X = "{(P  Q, R) | P Q R. (R, expandSet P Q)  sumComposeSet  hnf P  hnf Q}  {(R, P  Q) | P Q R. (R, expandSet P Q)  sumComposeSet  hnf P  hnf Q}"
  from assms have "(P  Q, R)  ?X" by auto
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim P Q)
    thus ?case
      by(blast intro: reflexive expandLeft expandRight)
  next
    case(cSym P Q)
     thus ?case by auto
   qed
 qed

end

Theory Strong_Late_Axiomatisation

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Axiomatisation
  imports Strong_Late_Expansion_Law
begin

lemma inputSuppPres:
  fixes P :: pi
  and   Q :: pi
  and   x :: name
  and   Rel  :: "(pi × pi) set"

  assumes PRelQ: "y. y  supp(P, Q, x)  (P[x::=y], Q[x::=y])  Rel"
  and     Eqvt: "eqvt Rel"

  shows "a<x>.P ↝[Rel] a<x>.Q"
proof -
  from Eqvt show ?thesis
  proof(induct rule: simCasesCont[where C="(x, a, Q, P)"])
    case(Bound b y Q')
    have "x  supp(P, Q, x)" by(simp add: supp_prod supp_atm)
    with PRelQ have "(P, Q)  Rel" by fastforce
    have QTrans: "a<x>.Q  b«y»  Q'" by fact
    have "y  (x, a, Q, P)" by fact
    hence "y  a" and yineqx: "y  x" and "y  Q" and "y  P" by(simp add: fresh_prod)+
    with QTrans show ?case
    proof(induct rule: inputCases)
      have "a<y>.([(x, y)]  P) a<y>  ([(x, y)]  P)" by(rule Input)
      hence "a<x>.P a<y>  ([(x, y)]  P)" using y  P by(simp add: alphaInput)
      moreover have "derivative ([(x, y)]  P) ([(x, y)]  Q) (InputS a) y Rel"
      proof(auto simp add: derivative_def)
        fix u
        have "x  supp(P, Q, x)" by(simp add: supp_prod supp_atm)
        have "(P[x::=u], Q[x::=u])  Rel"
        proof(cases "u  supp(P, Q, x)")
          case True
          with PRelQ show ?thesis by auto
        next
          case False
          hence "u  P" and "u  Q" by(auto simp add: fresh_def supp_prod)
          moreover from ‹eqvt Rel (P, Q)  Rel have "([(x, u)]  P, [(x, u)]  Q)  Rel"
            by(rule eqvtRelI)
          ultimately show ?thesis by(simp only: injPermSubst)
        qed
        with y  P y  Q show "(([(x, y)]  P)[y::=u], ([(x, y)]  Q)[y::=u])  Rel"
          by(simp add: renaming)
      qed
      ultimately show "P'. a<x>.P  a<y>  P'  derivative P' ([(x, y)]  Q) (InputS a) y Rel"
        by blast
    qed
  next
    case(Free α Q')
    have "a<x>.Q  α  Q'" by fact
    hence False by auto
    thus ?case by blast
  qed
qed

lemma inputSuppPresBisim:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes PSimQ: "y. y  supp(P, Q, x)  P[x::=y]  Q[x::=y]"

  shows "a<x>.P  a<x>.Q"
proof -
  let ?X = "{(a<x>.P, a<x>.Q) | a x P Q. y  supp(P, Q, x). P[x::=y]  Q[x::=y]}"
  have "eqvt ?X"
    apply(auto simp add: eqvt_def)
    apply(rule_tac x="perma  aa" in exI)
    apply(rule_tac x="perma  x" in exI)
    apply(rule_tac x="perma  P" in exI)
    apply auto
    apply(rule_tac x="perma  Q" in exI)
    apply auto
    apply(drule_tac pi="rev perma" in pt_set_bij2[OF pt_name_inst, OF at_name_inst])
    apply(simp add: eqvts pt_rev_pi[OF pt_name_inst, OF at_name_inst])
    apply(erule_tac x="rev perma  y" in ballE)
    apply auto
    apply(drule_tac p=perma in bisimClosed)
    by(simp add: eqvts pt_pi_rev[OF pt_name_inst, OF at_name_inst])
  from assms have "(a<x>.P, a<x>.Q)  ?X" by fastforce
  thus ?thesis
  proof(coinduct rule: bisimCoinduct)
    case(cSim P Q)
    thus ?case using ‹eqvt ?X
      by(fastforce intro: inputSuppPres)
  next
    case(cSym P Q)
    thus ?case by(fastforce simp add: supp_prod dest: symmetric)
  qed
qed

inductive equiv :: "pi  pi  bool" (infixr "e" 80)
where
  Refl:              "P e P"
| Sym:               "P e Q  Q e P"
| Trans:             "P e Q; Q e R  P e R"

| Match:             "[aa]P e P"
| Match':            "a  b  [ab]P e 𝟬"

| Mismatch:         "a  b  [ab]P e P"
| Mismatch':        "[aa]P e 𝟬"
 
| SumSym:            "P  Q e Q  P"
| SumAssoc:          "(P  Q)  R e P  (Q  R)"
| SumZero:           "P  𝟬 e P"
| SumIdemp:          "P  P e P"
| SumRes:            "x>(P  Q) e (x>P)  (x>Q)"

| ResNil:            "x>𝟬 e 𝟬"
| ResInput:          "x  a; x  y  x>a<y>.P e a<y>.(x>P)"
| ResInput':         "x>x<y>.P e 𝟬"
| ResOutput:         "x  a; x  b  x>a{b}.P e a{b}.(x>P)"
| ResOutput':        "x>x{b}.P e 𝟬"
| ResTau:            "x>τ.(P) e τ.(x>P)"
| ResComm:           "x>y>P e y>x>P"
| ResFresh:          "x  P  x>P e P"

| Expand:            "(R, expandSet P Q)  sumComposeSet; hnf P; hnf Q  P  Q e R"

| SumPres:           "P e Q  P  R e Q  R" 
| ParPres:           "P e P'; Q e Q'  P  Q e P'  Q'"
| ResPres:           "P e Q  x>P e x>Q"
| TauPres:           "P e Q  τ.(P) e τ.(Q)"
| OutputPres:        "P e Q  a{b}.P e a{b}.Q"
| InputPres:         "y  supp(P, Q, x). P[x::=y] e Q[x::=y]  a<x>.P e a<x>.Q"

lemma SumIdemp':
  fixes P  :: pi
  and   P' :: pi

  assumes "P e P'"

  shows "P  P' e P"
proof -
  have "P e P  P" by(blast intro: Sym SumIdemp)
  moreover from assms have "P  P e P'  P" by(rule SumPres)
  moreover have "P'  P e P  P'" by(rule SumSym)
  ultimately have "P e P  P'" by(blast intro: Trans)
  thus ?thesis by(rule Sym)
qed

lemma SumPres':
  fixes P  :: pi
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi

  assumes PeqP': "P e P'"
  and     QeqQ': "Q e Q'"

  shows "P  Q e P'  Q'"
proof -
  from PeqP' have "P  Q e P'  Q" by(rule SumPres)
  moreover have "P'  Q e Q  P'" by(rule SumSym)
  moreover from QeqQ' have "Q  P' e Q'  P'" by(rule SumPres)
  moreover have "Q'  P' e P'  Q'" by(rule SumSym)
  ultimately show ?thesis by(blast intro: Trans)
qed
(*
lemma ParComm:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes "(R, expandSet P Q) ∈ sumComposeSet"

  obtains R' where "(R, expandSet Q P) ∈ sumComposeSet" and "R ≡e R'"
using assms
apply(induct S=="expandSet P Q" rule: sumComposeSet.induct)
apply auto
apply(simp add: expandSet_def)
apply fastforce
apply auto
apply(clarify)
*)
lemma sound:
  fixes P :: pi
  and   Q :: pi

  assumes "P e Q"

  shows "P  Q"
using assms
proof(induct)
  case(Refl P)
  show ?case by(rule reflexive)
next
  case(Sym P Q)
  have "P  Q" by fact
  thus ?case by(rule symmetric)
next
  case(Trans P Q R)
  have "P  Q" and "Q  R" by fact+
  thus ?case by(rule transitive)
next
  case(Match a P)
  show ?case by(rule matchId)
next
  case(Match' a b P)
  have "a  b" by fact
  thus ?case by(rule matchNil)
next
  case(Mismatch a b P)
  have "a  b" by fact
  thus ?case by(rule mismatchId)
next
  case(Mismatch' a P)
  show ?case by(rule mismatchNil)
next
  case(SumSym P Q)
  show ?case by(rule sumSym)
next
  case(SumAssoc P Q R)
  show ?case by(rule sumAssoc)
next
  case(SumZero P)
  show ?case by(rule sumZero)
next
  case(SumIdemp P)
  show ?case by(rule sumIdemp)
next
  case(SumRes x P Q)
  show ?case by(rule sumRes)
next
  case(ResNil x)
  show ?case by(rule nilRes)
next
  case(ResInput x a y P)
  have "x  a" and "x  y" by fact+
  thus ?case by(rule resInput)
next
  case(ResInput' x y P)
  show ?case by(rule resNil)
next
  case(ResOutput x a b P)
  have "x  a" and "x  b" by fact+
  thus ?case by(rule resOutput)
next
  case(ResOutput' x b P)
  show ?case by(rule resNil)
next
  case(ResTau x P)
  show ?case by(rule resTau)
next
  case(ResComm x P)
  show ?case by(rule resComm)
next
  case(ResFresh x P)
  have "x  P" by fact
  thus ?case by(rule scopeFresh)
next
  case(Expand R P Q)
  have "(R, expandSet P Q)  sumComposeSet" and "hnf P" and "hnf Q" by fact+
  thus ?case by(rule expandSC)
next
  case(SumPres P Q R)
  from P  Q show ?case by(rule sumPres)
next
  case(ParPres P P' Q Q')
  have "P  P'" and "Q  Q'" by fact+
  thus ?case by(metis transitive symmetric parPres parSym)
next
  case(ResPres P Q x)
  from P  Q show ?case by(rule resPres)
next
  case(TauPres P Q)
  from P  Q show ?case by(rule tauPres)
next
  case(OutputPres P Q a b)
  from P  Q show ?case by(rule outputPres)
next
  case(InputPres P Q x a)
  have "y  supp(P, Q, x). P[x::=y] e Q[x::=y]  P[x::=y]  Q[x::=y]" by fact
  hence "y  supp(P, Q, x). P[x::=y]  Q[x::=y]" by blast
  thus ?case by(rule_tac inputSuppPresBisim) auto
qed

lemma zeroDest[dest]:
  fixes a :: name
  and   b :: name
  and   x :: name
  and   P :: pi

  shows "(a{b}.P) e 𝟬  False"
  and   "(a<x>.P) e 𝟬  False"
  and   "(τ.(P)) e 𝟬  False"

  and   "𝟬 e a{b}.P  False"
  and   "𝟬 e a<x>.P  False"
  and   "𝟬 e τ.(P)  False"
by(auto dest: sound)

lemma eq_eqvt:
  fixes pi::"name prm"
  and   x::"'a::pt_name"
  shows "pi(x=y) = ((pix)=(piy))"
by(simp add: perm_bool perm_bij)
    
nominal_primrec "depth" :: "pi  nat" where
  "depth 𝟬 = 0"
| "depth (τ.(P)) = 1 + (depth P)"
| "a  x  depth (a<x>.P) = 1 + (depth P)"
| "depth (a{b}.P) = 1 + (depth P)"
| "depth ([ab]P) = (depth P)"
| "depth ([ab]P) = (depth P)"
| "depth (P  Q) = max (depth P) (depth Q)"
| "depth (P  Q) = ((depth P) + (depth Q))"
| "depth (x>P) = (depth P)"
| "depth (!P) = (depth P)"
apply(auto simp add: fresh_nat)
apply(finite_guess)+
by(fresh_guess)+

lemma depthEqvt[simp]:
  fixes P :: pi
  and   p :: "name prm"
  
  shows "depth(p  P) = depth P"
by(nominal_induct P rule: pi.strong_induct, auto simp add: name_bij)

lemma depthInput[simp]:
  fixes a :: name
  and   x :: name
  and   P :: pi

  shows "depth (a<x>.P) = 1 + (depth P)"
proof -
  obtain y where yineqa: "y  a" and yFreshP: "y  P"
    by(force intro: name_exists_fresh[of "(a, P)"] simp add: fresh_prod)
  from yFreshP have "a<x>.P = a<y>.([(x, y)]  P)" by(simp add: alphaInput)
  with yineqa show ?thesis by simp
qed

nominal_primrec "valid" :: "pi  bool" where
  "valid 𝟬 = True"
| "valid (τ.(P)) = valid P"
| "x  a  valid (a<x>.P) = valid P"
| "valid (a{b}.P) = valid P"
| "valid ([ab]P) = valid P"
| "valid ([ab]P) = valid P"
| "valid (P  Q) = ((valid P)  (valid Q))"
| "valid (P  Q) = ((valid P)  (valid Q))"
| "valid (x>P) = valid P"
| "valid (!P) = False"
apply(auto simp add: fresh_bool)
apply(finite_guess)+
by(fresh_guess)+

lemma validEqvt[simp]:
  fixes P :: pi
  and   p :: "name prm"
  
  shows "valid(p  P) = valid P"
by(nominal_induct P rule: pi.strong_induct, auto simp add: name_bij)

lemma validInput[simp]:
  fixes a :: name
  and   x :: name
  and   P :: pi

  shows "valid (a<x>.P) = valid P"
proof -
  obtain y where yineqa: "y  a" and yFreshP: "y  P"
    by(force intro: name_exists_fresh[of "(a, P)"] simp add: fresh_prod)
  from yFreshP have "a<x>.P = a<y>.([(x, y)]  P)" by(simp add: alphaInput)
  with yineqa show ?thesis by simp
qed

lemma depthMin[intro]:
  fixes P

  shows "0  depth P"
by(induct P rule: pi.induct, auto)

lemma hnfTransition:
  fixes P :: pi

  assumes "hnf P"
  and     "P  𝟬"

  shows "Rs. P  Rs"
using assms
by(induct rule: pi.induct, auto intro: Output Tau Input Sum1 Open)

definition "uhnf" :: "pi  bool" where
  "uhnf P  hnf P  (R  summands P. R'  summands P. R  R'  ¬(R e R'))"

lemma summandsIdemp:
  fixes P :: pi
  and   Q :: pi

  assumes "Q  summands P"
  and     "Q e Q'"
  
  shows "P  Q' e P"
using assms
proof(nominal_induct P arbitrary: Q rule: pi.strong_inducts)
  case(PiNil Q)
  have "Q  summands 𝟬" by fact
  hence False by simp
  thus ?case by simp
next
  case(Output a b P Q)
  have "Q e Q'" by fact
  hence "a{b}.P  Q' e a{b}.P  Q" by(blast intro: SumPres' Refl Sym)
  moreover have "Q = a{b}.P"
  proof  -
    have "Q  summands (a{b}.P)" by fact
    thus ?thesis by simp
  qed
  ultimately show ?case by(blast intro: SumIdemp Trans)
next
  case(Tau P Q)
  have "Q e Q'" by fact
  hence "τ.(P)  Q' e τ.(P)  Q" by(blast intro: SumPres' Refl Sym)
  moreover have "Q = τ.(P)"
  proof  -
    have "Q  summands (τ.(P))" by fact
    thus ?thesis by simp
  qed
  ultimately show ?case by(blast intro: SumIdemp Trans)
next
  case(Input a x P Q)
  have "Q e Q'" by fact
  hence "a<x>.P  Q' e a<x>.P  Q" by(blast intro: SumPres' Refl Sym)
  moreover have "Q = a<x>.P"
  proof  -
    have "Q  summands (a<x>.P)" by fact
    thus ?thesis by simp
  qed
  ultimately show ?case by(blast intro: SumIdemp Trans)
next
  case(Match a b P Q)
  have "Q  summands ([ab]P)" by fact
  hence False by simp
  thus ?case by simp
next
  case(Mismatch a b P Q)
  have "Q  summands ([ab]P)" by fact
  hence False by simp
  thus ?case by simp
next
  case(Sum P Q R)
  have IHP: "P'. P'  summands P; P' e Q'  P  Q' e P" by fact
  have IHQ: "Q''. Q''  summands Q; Q'' e Q'  Q  Q' e Q" by fact
  have ReqQ': "R e Q'" by fact
  have "R  summands(P  Q)" by fact
  hence "R  summands P  R  summands Q" by simp
  thus ?case
  proof(rule disjE)
    assume "R  summands P"
    hence PQ'eqP: "P  Q' e P" using ReqQ' by(rule IHP)
    
    have "(P  Q)  Q' e P  (Q  Q')" by(rule SumAssoc)
    moreover have "P  (Q  Q') e P  (Q'  Q)" by(blast intro: Refl SumSym SumPres')
    moreover have "P  (Q'  Q) e (P  Q')  Q" by(blast intro: SumAssoc Sym)
    moreover from PQ'eqP have "(P  Q')  Q e P  Q" by(blast intro: SumPres' Refl)
    ultimately show ?case by(blast intro: Trans)
  next
    assume "R  summands Q"
    hence QQ'eqQ: "Q  Q' e Q" using ReqQ' by(rule IHQ)
    
    have "(P  Q)  Q' e P  (Q  Q')" by(rule SumAssoc)
    moreover from QQ'eqQ have "P  (Q  Q') e P  Q" by(blast intro: Refl SumPres')
    ultimately show ?case by(rule Trans)
  qed
next
  case(Par P Q R)
  have "R  summands (P  Q)" by fact
  hence False by simp
  thus ?case by simp
next
  case(Res x P Q)
  have "Q e Q'" by fact
  hence "(x>P)  Q' e (x>P)  Q" by(blast intro: SumPres' Refl Sym)
  moreover have "Q = x>P"
  proof  -
    have "Q  summands (x>P)" by fact
    thus ?thesis by(auto simp add: if_split)
  qed
  ultimately show ?case by(blast intro: SumIdemp Trans)
next
  case(Bang P Q)
  have "Q  summands(!P)" by fact
  hence False by simp
  thus ?case by simp
qed

lemma uhnfSum:
  fixes P :: pi
  and   Q :: pi

  assumes Phnf: "uhnf P"
  and     Qhnf: "uhnf Q"
  and     validP: "valid P"
  and     validQ: "valid Q"

  shows "R. uhnf R  valid R  P  Q e R  (depth R)  (depth (P  Q))"
using assms
proof(nominal_induct P arbitrary: Q rule: pi.strong_inducts)
  case(PiNil Q)
  have "uhnf Q" by fact
  moreover have "valid Q" by fact
  moreover have "𝟬  Q e Q" by(blast intro: SumZero SumSym Trans)
  moreover have "depth Q  depth(𝟬  Q)" by auto
  ultimately show ?case by blast
next
  case(Output a b P Q)
  show ?case
  proof(case_tac "Q = 𝟬")
    assume "Q = 𝟬"
    moreover have "uhnf (a{b}.P)" by(simp add: uhnf_def)
    moreover have "valid (a{b}.P)" by fact
    moreover have "a{b}.P  𝟬 e a{b}.P" by(rule SumZero)
    moreover have "depth(a{b}.P)  depth(a{b}.P  𝟬)" by simp
    ultimately show ?case by blast
  next
    assume QineqNil: "Q  𝟬" 
    have Qhnf: "uhnf Q" by fact
    have validQ: "valid Q" by fact
    have validP: "valid(a{b}.P)" by fact
    show ?case
    proof(case_tac "Q'  summands Q. Q' e a{b}.P")
      assume "Q'  summands Q. Q' e a{b}.P"
      then obtain Q' where "Q'  summands Q" and "Q' e a{b}.P" by blast
      hence "Q  a{b}.P e Q" by(rule summandsIdemp)
      moreover have "depth Q  depth(Q  a{b}.P)" by simp
      ultimately show ?case using Qhnf validQ by(force intro: SumSym Trans)
    next
      assume "¬(Q'  summands Q. Q' e a{b}.P)"
      hence "Q'  summands Q. ¬(Q' e a{b}.P)" by simp
      with Qhnf QineqNil have "uhnf (a{b}.P  Q)"
        by(force dest: Sym simp add: uhnf_def)
      moreover from validQ validP have "valid(a{b}.P  Q)"  by simp
      moreover have "a{b}.P  Q e a{b}.P  Q" by(rule Refl)
      moreover have "depth(a{b}.P  Q)  depth(a{b}.P  Q)" by simp
      ultimately show ?case by blast
    qed
  qed
next
  case(Tau P Q)
  show ?case
  proof(case_tac "Q = 𝟬")
    assume "Q = 𝟬"
    moreover have "uhnf (τ.(P))" by(simp add: uhnf_def)
    moreover have "valid (τ.(P))" by fact
    moreover have "τ.(P)  𝟬 e τ.(P)" by(rule SumZero)
    moreover have "depth(τ.(P))  depth(τ.(P)  𝟬)" by simp
    ultimately show ?case by blast
  next
    assume QineqNil: "Q  𝟬" 
    have Qhnf: "uhnf Q" by fact
    have validP: "valid(τ.(P))" and validQ: "valid Q" by fact+
    show ?case
    proof(case_tac "Q'  summands Q. Q' e τ.(P)")
      assume "Q'  summands Q. Q' e τ.(P)"
      then obtain Q' where "Q'  summands Q" and "Q' e τ.(P)" by blast
      hence "Q  τ.(P) e Q" by(rule summandsIdemp)
      moreover have "depth Q  depth(Q  τ.(P))" by simp
      ultimately show ?case using Qhnf validQ by(force intro: SumSym Trans)
    next
      assume "¬(Q'  summands Q. Q' e τ.(P))"
      hence "Q'  summands Q. ¬(Q' e τ.(P))" by simp
      with Qhnf QineqNil have "uhnf (τ.(P)  Q)"
        by(force dest: Sym simp add: uhnf_def)
      moreover from validP validQ have "valid(τ.(P)  Q)" by simp
      moreover have "τ.(P)  Q e τ.(P)  Q" by(rule Refl)
      moreover have "depth(τ.(P)  Q)  depth(τ.(P)  Q)" by simp
      ultimately show ?case by blast
    qed
  qed
next
  case(Input a x P Q)
  show ?case
  proof(case_tac "Q = 𝟬")
    assume "Q = 𝟬"
    moreover have "uhnf (a<x>.P)" by(simp add: uhnf_def)
    moreover have "valid (a<x>.P)" by fact
    moreover have "a<x>.P  𝟬 e a<x>.P" by(rule SumZero)
    moreover have "depth(a<x>.P)  depth(a<x>.P  𝟬)" by simp
    ultimately show ?case by blast
  next
    assume QineqNil: "Q  𝟬" 
    have validP: "valid(a<x>.P)" and validQ: "valid Q" by fact+
    have Qhnf: "uhnf Q" by fact
    show ?case
    proof(case_tac "Q'  summands Q. Q' e a<x>.P")
      assume "Q'  summands Q. Q' e a<x>.P"
      then obtain Q' where "Q'  summands Q" and "Q' e a<x>.P" by blast
      hence "Q  a<x>.P e Q" by(rule summandsIdemp)
      moreover have "depth Q  depth(Q  a<x>.P)" by simp
      ultimately show ?case using Qhnf validQ by(force intro: SumSym Trans)
    next
      assume "¬(Q'  summands Q. Q' e a<x>.P)"
      hence "Q'  summands Q. ¬(Q' e a<x>.P)" by simp
      with Qhnf QineqNil have "uhnf (a<x>.P  Q)"
        by(force dest: Sym simp add: uhnf_def)
      moreover from validP validQ have "valid(a<x>.P  Q)" by simp
      moreover have "a<x>.P  Q e a<x>.P  Q" by(rule Refl)
      moreover have "depth(a<x>.P  Q)  depth(a<x>.P  Q)" by simp
      ultimately show ?case by blast
    qed
  qed
next
  case(Match a b P Q)
  have "uhnf ([ab]P)" by fact
  hence False by(simp add: uhnf_def)
  thus ?case by simp
next
  case(Mismatch a b P Q)
  have "uhnf ([ab]P)" by fact
  hence False by(simp add: uhnf_def)
  thus ?case by simp
next
  case(Sum P Q R)
  have Rhnf: "uhnf R" by fact
  have validR: "valid R" by fact
  have PQhnf: "uhnf (P  Q)" by fact
  have validPQ: "valid(P  Q)" by fact
  have "T. uhnf T  valid T  Q  R e T  depth T  depth (Q  R)"
  proof -
    from PQhnf have "uhnf Q" by(simp add: uhnf_def)
    moreover from validPQ have "valid Q" by simp+
    moreover have "R. uhnf Q; uhnf R; valid Q; valid R  T. uhnf T  valid T  Q  R e T  depth T  depth(Q  R)" by fact
    ultimately show ?thesis using Rhnf validR by blast
  qed
  then obtain T where Thnf: "uhnf T" and QReqT: "Q  R e T" and validT: "valid T"
                  and Tdepth: "depth T  depth(Q  R)" by blast
  
  have "S. uhnf S  valid S  P  T e S  depth S  depth(P  T)"
  proof -
    from PQhnf have "uhnf P" by(simp add: uhnf_def)
    moreover from validPQ have "valid P" by simp
    moreover have "T. uhnf P; uhnf T; valid P; valid T  S. uhnf S  valid S  P  T e S  depth S  depth(P  T)" by fact
    ultimately show ?thesis using Thnf validT by blast
  qed
  then obtain S where Shnf: "uhnf S" and PTeqS: "P  T e S" and validS: "valid S"
                  and Sdepth: "depth S  depth(P  T)" by blast
    
  have "(P  Q)  R e S"
  proof -
    have "(P  Q)  R e P  (Q  R)" by(rule SumAssoc)
    moreover from QReqT have "P  (Q  R) e P  T"
      by(blast intro: Refl SumPres')
    ultimately show ?thesis using PTeqS by(blast intro: Trans)
  qed
  moreover from Tdepth Sdepth have "depth S  depth((P  Q)  R)" by auto
  
  ultimately show ?case using Shnf validS by blast
next
  case(Par P Q R)
  have "uhnf (P  Q)" by fact
  hence False by(simp add: uhnf_def)
  thus ?case by simp
next
  case(Res x P Q)
  show ?case
  proof(case_tac "Q = 𝟬")
    assume "Q = 𝟬"
    moreover have "uhnf (x>P)" by fact
    moreover have "valid (x>P)" by fact
    moreover have "x>P  𝟬 e x>P" by(rule SumZero)
    moreover have "depth(x>P)  depth((x>P)  𝟬)" by simp
    ultimately show ?case by blast
  next
    assume QineqNil: "Q  𝟬" 
    have Qhnf: "uhnf Q" by fact
    have validP: "valid(x>P)" and validQ: "valid Q" by fact+
    show ?case
    proof(case_tac "Q'  summands Q. Q' e x>P")
      assume "Q'  summands Q. Q' e x>P"
      then obtain Q' where "Q'  summands Q" and "Q' e x>P" by blast
      hence "Q  x>P e Q" by(rule summandsIdemp)
      moreover have "depth Q  depth(Q  x>P)" by simp
      ultimately show ?case using Qhnf validQ by(force intro: SumSym Trans)
    next
      assume "¬(Q'  summands Q. Q' e x>P)"
      hence "Q'  summands Q. ¬(Q' e x>P)" by simp
      moreover have "uhnf (x>P)" by fact
      ultimately have "uhnf (x>P  Q)" using Qhnf QineqNil 
        by(force dest: Sym simp add: uhnf_def)
      moreover from validP validQ have "valid(x>P  Q)" by simp
      moreover have "(x>P)  Q e (x>P)  Q" by(rule Refl)
      moreover have "depth((x>P)  Q)  depth((x>P)  Q)" by simp
      ultimately show ?case by blast
    qed
  qed
next
  case(Bang P Q)
  have "uhnf (!P)" by fact
  hence False by(simp add: uhnf_def)
  thus ?case by simp
qed

lemma uhnfRes:
  fixes x :: name
  and   P :: pi

  assumes Phnf: "uhnf P"
  and     validP: "valid P"

  shows "P'. uhnf P'  valid P'  x>P e P'  depth P'  depth(x>P)"
using assms
proof(nominal_induct P avoiding: x rule: pi.strong_inducts)
  case(PiNil x)
  have "uhnf 𝟬" by(simp add: uhnf_def)
  moreover have "valid 𝟬" by simp
  moreover have "x>𝟬 e 𝟬" by(rule ResNil)
  moreover have "depth 𝟬  depth(x>𝟬)" by simp
  ultimately show ?case by blast
next
  case(Output a b P)
  have "valid(a{b}.P)" by fact
  hence validP: "valid P" by simp
  show ?case
  proof(case_tac "x=a")
    assume "x = a"
    moreover have "uhnf 𝟬" by(simp add: uhnf_def)
    moreover have "valid 𝟬" by simp
    moreover have "𝟬 e x>x{b}.P" by(blast intro: ResOutput' Sym)
    moreover have "depth 𝟬  depth(x>x{b}.P)" by simp
    ultimately show ?case by(blast intro: Sym)
  next
    assume xineqa: "x  a"
    show ?case
    proof(case_tac "x=b")
      assume "x=b"
      moreover from xineqa have "uhnf(x>a{x}.P)" by(force simp add: uhnf_def)
      moreover from validP have "valid(x>a{x}.P)" by simp
      moreover have "x>a{x}.P e x>a{x}.P" by(rule Refl)
      moreover have "depth(x>a{x}.P)  depth(x>a{x}.P)" by simp
      ultimately show ?case by blast
    next
      assume xineqb: "x  b"
      have "uhnf(a{b}.(x>P))" by(simp add: uhnf_def)
      moreover from validP have "valid(a{b}.(x>P))" by simp
      moreover from xineqa xineqb have "a{b}.(x>P) e x>a{b}.P" by(blast intro: ResOutput Sym)
      moreover have "depth(a{b}.(x>P))  depth(x>a{b}.P)" by simp
      ultimately show ?case by(blast intro: Sym)
    qed
  qed
next
  case(Tau P)
  have "valid(τ.(P))" by fact
  hence validP: "valid P" by simp
  
  have "uhnf(τ.(x>P))" by(simp add: uhnf_def)
  moreover from validP have "valid(τ.(x>P))" by simp
  moreover have "τ.(x>P) e x>τ.(P)" by(blast intro: ResTau Sym)
  moreover have "depth(τ.(x>P))  depth(x>τ.(P))" by simp
  ultimately show ?case by(blast intro: Sym)
next
  case(Input a y P x)
  have "valid(a<y>.P)" by fact
  hence validP: "valid P" by simp
  have "y  x" by fact hence yineqx: "y  x" by simp
  show ?case
  proof(case_tac "x=a")
    assume "x = a"
    moreover have "uhnf 𝟬" by(simp add: uhnf_def)
    moreover have "valid 𝟬" by simp
    moreover have "𝟬 e x>x<y>.P" by(blast intro: ResInput' Sym)
    moreover have "depth 𝟬  depth(x>x<y>.P)" by simp
    ultimately show ?case by(blast intro: Sym)
  next
    assume xineqa: "x  a"
    have "uhnf(a<y>.(x>P))" by(simp add: uhnf_def)
    moreover from validP have "valid(a<y>.(x>P))" by simp
    moreover from xineqa yineqx have "a<y>.(x>P) e x>a<y>.P" by(blast intro: ResInput Sym)
    moreover have "depth(a<y>.(x>P))  depth(x>a<y>.P)" by simp
    ultimately show ?case by(blast intro: Sym)
  qed
next
  case(Match a b P x)
  have "uhnf([ab]P)" by fact
  hence False by(simp add: uhnf_def)
  thus ?case by simp
next
  case(Mismatch a b P x)
  have "uhnf([ab]P)" by fact
  hence False by(simp add: uhnf_def)
  thus ?case by simp
next
  case(Sum P Q x)
  have "valid(P  Q)" by fact
  hence validP: "valid P" and validQ: "valid Q" by simp+
  have "uhnf(P  Q)" by fact
  hence Phnf: "uhnf P" and Qhnf: "uhnf Q" by(auto simp add: uhnf_def)
  
  have "P'. uhnf P'  valid P'  P' e x>P  (depth P')  (depth(x>P))"
  proof -
    have "uhnf P; valid P  P'. uhnf P'  valid P'  x>P e P'  (depth P')  (depth (x>P))" by fact
    with validP Phnf show ?thesis by(blast intro: Sym)
  qed
  then obtain P' where P'hnf: "uhnf P'" and P'eqP: "P' e x>P" and validP': "valid P'"
                   and P'depth: "(depth P')  (depth(x>P))" by blast

  have "Q'. uhnf Q'  valid Q'  Q' e x>Q  (depth Q')  (depth(x>Q))"
  proof -
    have "uhnf Q; valid Q  Q'. uhnf Q'  valid Q'  x>Q e Q'  (depth Q')  (depth(x>Q))" by fact
    with validQ Qhnf show ?thesis by(blast intro: Sym)
  qed
  
  then obtain Q' where Q'hnf: "uhnf Q'" and Q'eqQ: "Q' e x>Q" and validQ': "valid Q'"
                   and Q'depth: "(depth Q')  (depth(x>Q))" by blast    
      
  from P'hnf Q'hnf validP' validQ' obtain R where Rhnf: "uhnf R" and validR: "valid R"
                                              and P'Q'eqR: "P'  Q' e R"
                                              and Rdepth: "depth R  depth(P'  Q')"
    apply(drule_tac uhnfSum) apply assumption+ by blast
    
  from P'eqP Q'eqQ P'Q'eqR have "x>(P  Q) e R" by(blast intro: Sym SumPres' SumRes Trans)
  moreover from Rdepth P'depth Q'depth have "depth R  depth(x>(P  Q))" by auto
  ultimately show ?case using validR Rhnf by(blast intro: Sym)
next
  case(Par P Q)
  have "uhnf(P  Q)" by fact
  hence False by(simp add: uhnf_def)
  thus ?case by simp
next
  case(Res y P x)
  have "valid(y>P)" by fact hence validP: "valid P" by simp
  have "uhnf(y>P)" by fact
  then obtain a P' where aineqy: "a  y" and PeqP': "P = a{y}.P'"
    by(force simp add: uhnf_def)
    
  show ?case
  proof(case_tac "x=y")
    assume "x=y"
    moreover from aineqy have "uhnf(y>a{y}.P')" by(force simp add: uhnf_def)
    moreover from validP PeqP' have "valid(y>a{y}.P')" by simp
    moreover have "y>y>a{y}.P' e y>a{y}.P'"
    proof -
      have "y  y>a{y}.P'" by(simp add: name_fresh_abs)
      hence "y>y>a{y}.P' e y>a{y}.P'" by(rule ResFresh)
      thus ?thesis by(blast intro: Trans)
    qed
    moreover have "depth(y>a{y}.P')  depth(y>y>a{y}.P')" by simp
    ultimately show ?case using PeqP' by blast
  next
    assume xineqy: "xy"
    show ?case
    proof(case_tac "x=a")
      assume "x=a"
      moreover have "uhnf 𝟬" by(simp add: uhnf_def)
      moreover have "valid 𝟬" by simp
      moreover have "a>y>a{y}.P' e 𝟬"
      proof -
        have "a>y>a{y}.P' e y>a>a{y}.P'" by(rule ResComm)
        moreover have "y>a>a{y}.P' e 𝟬"
          by(blast intro: ResOutput' ResNil ResPres Trans)
        ultimately show ?thesis by(blast intro: Trans)
      qed
      moreover have "depth 𝟬  depth(a>y>a{y}.P')" by simp
      ultimately show ?case using PeqP' by blast
    next
      assume xineqa: "x  a"
      from aineqy have "uhnf(y>a{y}.(x>P'))" by(force simp add: uhnf_def)
      moreover from validP PeqP' have "valid(y>a{y}.(x>P'))" by simp
      moreover have "x>y>a{y}.P' e y>a{y}.(x>P')"
      proof -
        have "x>y>a{y}.P' e y>x>a{y}.P'" by(rule ResComm)
        moreover from xineqa xineqy have "y>x>a{y}.P' e y>a{y}.(x>P')"
          by(blast intro: ResOutput ResPres Trans)
        ultimately show ?thesis by(blast intro: Trans)
      qed
      moreover have "depth(y>a{y}.(x>P'))  depth(x>y>a{y}.P')"
        by simp
      ultimately show ?case using PeqP' by blast
    qed
  qed
next
  case(Bang P x)
  have "valid(!P)" by fact
  hence False by simp
  thus ?case by simp
qed

lemma expandHnf:
  fixes P :: pi
  and   S :: "pi set"

  assumes "(P, S)  sumComposeSet"
  and     "P  S. uhnf P  valid P"

  shows "P'. uhnf P'  valid P'  P e P'  depth P'  depth P"
using assms
proof(induct rule: sumComposeSet.induct)
  case empty
  have "uhnf 𝟬" by(simp add: uhnf_def)
  moreover have "valid 𝟬" by simp
  moreover have "𝟬 e 𝟬" by(rule Refl)
  moreover have "depth 𝟬  depth 𝟬" by simp
  ultimately show ?case by blast
next
  case(insert Q S P)
  have Shnf: "P  S. uhnf P  valid P" by fact
  hence "P  (S - {(Q)}). uhnf P  valid P" by simp
  moreover have "P  (S - {(Q)}). uhnf P  valid P  P'. uhnf P'  valid P'  P e P'  depth P'  depth P" by fact
  ultimately obtain P' where P'hnf: "uhnf P'" and validP': "valid P'"
                         and PeqP': "P e P'" and PP'depth: "depth P'  depth P"
    by blast
  
  have "Q  S" by fact
  with Shnf have "uhnf Q" and "valid Q" by simp+
  with P'hnf validP' obtain R where Rhnf: "uhnf R" and validR: "valid R"
                                and P'QeqR: "P'  Q e R" and P'QRdepth: "depth R  depth (P'  Q)"
    by(auto dest: uhnfSum)
  
  from PeqP' P'QeqR have "P  Q e R" by(blast intro: SumPres Trans)
  moreover from PP'depth P'QRdepth have "depth R  depth(P  Q)" by simp
  ultimately show ?case using Rhnf validR by blast
qed

lemma hnfSummandsRemove:
  fixes P :: pi
  and   Q :: pi

  assumes "P  summands Q"
  and     "uhnf Q"

  shows "(summands Q) - {P' | P'. P'  summands Q  P' e P} = (summands Q) - {P}"
using assms
by(auto intro: Refl simp add: uhnf_def)

lemma pullSummand:
  fixes P  :: pi
  and   Q  :: pi

  assumes PsummQ: "P  summands Q"
  and     Qhnf:   "uhnf Q"

  shows "Q'. P  Q' e Q  (summands Q') = ((summands Q)  - {x. P'. x = P'  P'  (summands Q)  P' e P})  uhnf Q'"
proof -
  have SumGoal: "P Q R. P  summands Q; uhnf(Q  R);
                           P. P  summands Q  Q'. P  Q' e Q  
                                   (summands Q') = ((summands Q) - {P' |P'. P'  summands Q  P' e P})  uhnf Q';
                           P. P  summands R  R'. P  R' e R  
                                   (summands R') = ((summands R) - {P' |P'. P'  summands R  P' e P})  uhnf R'
     Q'. P  Q' e Q  R 
             summands Q' = summands (pi.Sum Q R) - {P' |P'. P'  summands (Q  R)  P' e P}  uhnf Q'"
  proof -
    fix P Q R
    assume IHR: "P. P  summands R  R'. P  R' e R  
                                         (summands R') = ((summands R) - {P' |P'. P'  summands R  P' e P})  uhnf R'"
    assume PsummQ: "P  summands Q"
    moreover assume "P. P  summands Q  Q'. P  Q' e Q  
                                   (summands Q') = ((summands Q) - {P' |P'. P'  summands Q  P' e P})  uhnf Q'" 

    ultimately obtain Q' where PQ'eqQ: "P  Q' e Q"
                           and Q'summQ: "(summands Q') = ((summands Q) - {P' |P'. P'  summands Q  P' e P})"
                           and Q'hnf: "uhnf Q'"
      by blast
    assume QRhnf: "uhnf(Q  R)"

    show "Q'. P  Q' e Q  R 
             summands Q' = summands (pi.Sum Q R) - {P' |P'. P'  summands (Q  R)  P' e P}  uhnf Q'"
    proof(cases "P'  summands R. P' e P")
      assume "P'  summands R. P' e P"
      then obtain P' where P'summR: "P'  summands R" and P'eqP: "P' e P" by blast
      with IHR obtain R' where PR'eqR: "P'  R' e R"
        and R'summR: "(summands R') = ((summands R) - {P'' |P''. P''  summands R  P'' e P'})"
        and R'hnf: "uhnf R'"
        by blast
      
      have L1: "P  (Q'  R') e Q  R"
      proof -
        from P'eqP have "P  (Q'  R') e (P  P')  (Q'  R')"
          by(blast intro: SumIdemp' SumPres Sym)
        moreover have "(P  P')  (Q'  R') e P  (P'  (Q'  R'))" by(rule SumAssoc)
        moreover have "P  (P'  (Q'  R')) e P  (P'  (R'  Q'))"
          by(blast intro: Refl SumPres' SumSym)
        moreover have "P  (P'  (R'  Q')) e P  (P'  R')  Q'"
          by(blast intro: Refl SumPres' Sym SumAssoc)
        moreover have "P  (P'  R')  Q' e (P  Q')  (P'  R')"
        proof -
          have "P  (P'  R')  Q' e P  Q'  (P'  R')"
            by(blast intro: Refl SumPres' SumSym)
          thus ?thesis by(blast intro: Sym SumAssoc Trans)
        qed
        moreover from PQ'eqQ PR'eqR have "(P  Q')  (P'  R') e Q  R" by(rule SumPres')
        ultimately show ?thesis by(blast intro!: Trans)
      qed
      
      show ?thesis
      proof(cases "Q' = 𝟬")
        assume Q'eqNil: "Q' = 𝟬"
        have "P  R' e Q  R"
        proof -
          have "P  R' e P  (R'  𝟬)" by(blast intro: SumZero Refl Trans SumPres' Sym)
          moreover have "P  (R'  𝟬) e P  (𝟬  R')"
            by(blast intro: SumSym Trans SumPres' Refl)
          ultimately show ?thesis using L1 Q'eqNil by(blast intro: Trans)
        qed
        moreover from R'summR Q'summQ P'eqP Q'eqNil have "summands (R') = (summands (Q  R) - {P' |P'. P'  summands(Q  R)  P' e P})"
          by(auto intro: Sym Trans)
        ultimately show ?thesis using R'hnf by blast
      next
        assume Q'ineqNil: "Q'  𝟬"
        show ?thesis
        proof(case_tac "R' = 𝟬")
          assume R'eqNil: "R' = 𝟬"
          have "P  Q' e Q  R"
          proof -
            have "P  Q' e P  (Q'  𝟬)" by(blast intro: SumZero Refl Trans SumPres' Sym)
            with L1 R'eqNil show ?thesis by(blast intro: Trans)
          qed
          moreover from R'summR Q'summQ P'eqP R'eqNil have "summands (Q') = (summands (Q  R) - {P' |P'. P'  summands(Q  R)  P' e P})"
            by(auto intro: Sym Trans)
          ultimately show ?thesis using Q'hnf by blast
        next
          assume R'ineqNil: "R'  𝟬"
          
          from R'summR Q'summQ P'eqP have "summands (Q'  R') = (summands (Q  R) - {P' |P'. P'  summands(Q  R)  P' e P})"
            by(auto intro: Sym Trans)
          moreover from QRhnf Q'hnf R'hnf R'summR Q'summQ Q'ineqNil R'ineqNil have "uhnf(Q'  R')"
            by(auto simp add: uhnf_def)
          
          ultimately show ?thesis using L1 by blast
        qed
      qed
    next
      assume "¬(P'  summands R. P' e P)"
      hence Case: "P'  summands R. ¬(P' e P)" by simp
      show ?thesis
      proof(case_tac "Q' = 𝟬")
        assume Q'eqNil: "Q' = 𝟬"
        have "P  R e Q  R" 
        proof -

          have "P  R e (P  𝟬)  R" by(blast intro: SumZero Sym Trans SumPres)
          moreover from  PQ'eqQ have "P  (Q'  R) e Q  R"
             by(blast intro: SumAssoc Trans Sym SumPres) 
           ultimately show ?thesis using Q'eqNil by(blast intro: SumAssoc Trans)
         qed
         
         moreover from Q'summQ Q'eqNil Case have "summands (R) = (summands (Q  R) - {P' |P'. P'  summands(Q  R)  P' e P})"
           by auto
         moreover from QRhnf have "uhnf R" by(simp add: uhnf_def)

         ultimately show ?thesis by blast       
       next
         assume Q'ineqNil: "Q'  𝟬"
         from PQ'eqQ have "P  (Q'  R) e Q  R" 
           by(blast intro: SumAssoc Trans Sym SumPres) 
         
         moreover from Q'summQ Case have "summands (Q'  R) = (summands (Q  R) - {P' |P'. P'  summands(Q  R)  P' e P})"
           by auto
         moreover from QRhnf Q'hnf Q'summQ Q'ineqNil have "uhnf (Q'  R)"
           by(auto simp add: uhnf_def)
         ultimately show ?thesis by blast
       qed
     qed
   qed

   from assms show ?thesis
   proof(nominal_induct Q arbitrary: P rule: pi.strong_inducts)
     case PiNil
     have "P  summands 𝟬" by fact
     hence False by auto
     thus ?case by simp
   next
     case(Output a b Q)
     have "P  summands (a{b}.Q)" by fact
     hence PeqQ: "P = a{b}.Q" by simp
     have "P  𝟬 e a{b}.Q"
     proof -
       have "P  𝟬 e P" by(rule SumZero)
       with PeqQ show ?thesis by simp
     qed
     moreover have "(summands 𝟬) = (summands (a{b}.Q)) - {P' | P'. P'  summands (a{b}.Q)  P' e P}"
     proof -
       have "a{b}.Q e a{b}.Q" by(rule Refl)
       with PeqQ show ?thesis by simp
     qed
     moreover have "uhnf 𝟬" by(simp add: uhnf_def)
     ultimately show ?case by blast
   next
     case(Tau Q)
     have "P  summands (τ.(Q))" by fact
     hence PeqQ: "P = τ.(Q)" by simp
     have "P  𝟬 e τ.(Q)"
     proof -
       have "P  𝟬 e P" by(rule SumZero)
       with PeqQ show ?thesis by simp
     qed
     moreover have "(summands 𝟬) = (summands (τ.(Q))) - {P' | P'. P'  summands (τ.(Q))  P' e P}"
     proof -
       have "τ.(Q) e τ.(Q)" by(rule Refl)
       with PeqQ show ?thesis by simp
     qed
     moreover have "uhnf 𝟬" by(simp add: uhnf_def)
     ultimately show ?case by blast
   next
     case(Input a x Q)
     have "P  summands (a<x>.Q)" by fact
     hence PeqQ: "P = a<x>.Q" by simp
     have "P  𝟬 e a<x>.Q"
     proof -
       have "P  𝟬 e P" by(rule SumZero)
       with PeqQ show ?thesis by simp
     qed
     moreover have "(summands 𝟬) = (summands (a<x>.Q)) - {P' | P'. P'  summands (a<x>.Q)  P' e P}"
     proof -
       have "a<x>.Q e a<x>.Q" by(rule Refl)
       with PeqQ show ?thesis by simp
     qed
     moreover have "uhnf 𝟬" by(simp add: uhnf_def)
     ultimately show ?case by blast
   next
     case(Match a b Q)
     have "P  summands ([ab]Q)" by fact
     hence False by simp
     thus ?case by simp
   next
     case(Mismatch a b Q)
     have "P  summands ([ab]Q)" by fact
     hence False by simp
     thus ?case by simp
   next
     case(Sum Q R)
     have QRhnf: "uhnf (Q  R)" by fact
     hence Qhnf: "uhnf Q" and Rhnf: "uhnf R" by(simp add: uhnf_def)+
     have "P. P  summands Q; uhnf Q  Q'. P  Q' e Q  
                                          (summands Q') = ((summands Q) - {P' |P'. P'  summands Q  P' e P})  uhnf Q'"
       by fact
     with Qhnf have IHQ: "P. P  summands Q  Q'. P  Q' e Q  
                                  (summands Q') = ((summands Q) - {P' |P'. P'  summands Q  P' e P})  uhnf Q'"
       by simp
     have "P. P  summands R; uhnf R  R'. P  R' e R  
                                          (summands R') = ((summands R) - {P' |P'. P'  summands R  P' e P})  uhnf R'"
       by fact
     with Rhnf have IHR: "P. P  summands R  R'. P  R' e R  
                                  (summands R') = ((summands R) - {P' |P'. P'  summands R  P' e P})  uhnf R'"
       by simp
     have "P  summands (Q  R)" by fact
     hence "P  summands Q  P  summands R" by simp
     thus ?case
     proof(rule disjE)
       assume "P  summands Q"
       thus ?case using QRhnf IHQ IHR by(rule SumGoal)
     next
       assume "P  summands R"
       moreover from QRhnf have "uhnf (R  Q)" by(auto simp add: uhnf_def)
       ultimately have "Q'. (pi.Sum P Q') e (pi.Sum R Q) 
         summands Q' = summands (pi.Sum R Q) - {P' |P'. P'  summands (pi.Sum R Q)  P' e P}  uhnf Q'" using IHR IHQ
         by(rule SumGoal)
       thus ?case 
         by(force intro: SumSym Trans)
     qed
   next
     case(Par Q R P)
     have "P  summands (Q  R)" by fact
     hence False by simp
     thus ?case by simp
   next
     case(Res x Q P)
     have "P  summands (x>Q)" by fact
     hence PeqQ: "P = x>Q" by(simp add: if_split)
     have "P  𝟬 e x>Q"
     proof -
       have "P  𝟬 e P" by(rule SumZero)
       with PeqQ show ?thesis by simp
     qed
     moreover have "(summands 𝟬) = (summands (x>Q)) - {P' | P'. P'  summands (x>Q)  P' e P}"
     proof -
       have "x>Q e x>Q" by(rule Refl)
       with PeqQ show ?thesis by simp
     qed
     moreover have "uhnf 𝟬" by(simp add: uhnf_def)
     ultimately show ?case by blast
   next
     case(Bang Q P)
     have "P  summands (!Q)" by fact
     hence False by simp
     thus ?case by simp
   qed
 qed
  
lemma nSym:
  fixes P :: pi
  and   Q :: pi

  assumes "¬(P e Q)"

  shows "¬(Q e P)"
using assms
by(blast dest: Sym)

lemma summandsZero:
  fixes P :: pi
  
  assumes "summands P = {}"
  and     "hnf P"

  shows "P = 𝟬"
using assms
by(nominal_induct P rule: pi.strong_inducts, auto intro: Refl SumIdemp SumPres' Trans)  

lemma summandsZero':
  fixes P :: pi
  
  assumes summP: "summands P = {}"
  and     Puhnf: "uhnf P"

  shows "P = 𝟬"
proof -
  from Puhnf have "hnf P" by(simp add: uhnf_def)
  with summP show ?thesis by(rule summandsZero)
qed

lemma summandEquiv:
  fixes P :: pi
  and   Q :: pi

  assumes Phnf: "uhnf P"
  and     Qhnf: "uhnf Q"
  and     PinQ: "P'  summands P. Q'  summands Q. P' e Q'"
  and     QinP: "Q'  summands Q. P'  summands P. Q' e P'"

  shows "P e Q"
proof -
  from finiteSummands assms show ?thesis
  proof(induct F=="summands P" arbitrary: P Q rule: finite_induct)
    case(empty P Q)
    have PEmpty: "{} = summands P" by fact
    moreover have "Q'summands Q. P'summands P. Q' e P'" by fact
    ultimately have QEmpty: "summands Q = {}" by simp
    
    have "P = 𝟬"
    proof -
      have "uhnf P" by fact
      with PEmpty show ?thesis by(blast intro: summandsZero')
    qed
    moreover have "Q = 𝟬"
    proof -
      have "uhnf Q" by fact
      with QEmpty show ?thesis by(blast intro: summandsZero')
    qed
    ultimately show ?case by(blast intro: Refl)
  next
    case(insert P' F P Q)
    have Phnf: "uhnf P" by fact
    have Qhnf: "uhnf Q" by fact
    
    have IH: "P Q. F = summands P; uhnf P; uhnf Q; P'  summands P. Q'  summands Q. P' e Q';
              Q'  summands Q. P'  summands P. Q' e P'  P e Q"
      by fact
    have PeqQ: "P'  summands P. Q'  summands Q. P' e Q'" by fact
    have QeqP: "Q'  summands Q. P'  summands P. Q' e P'" by fact
  
    have PSumm: "insert P' F = summands P" by fact
    hence P'SummP: "P'  summands P" by auto
    
    with Phnf obtain P'' where P'P''eqP: "P'  P'' e P" 
                           and P''Summ: "summands P'' = summands P - {P'' |P''. P''  summands P  P'' e P'}"
                           and P''hnf: "uhnf P''"
      by(blast dest: pullSummand)

    from PeqQ P'SummP obtain Q' where Q'SummQ: "Q'  summands Q" and P'eqQ': "P' e Q'" by blast
    
    from Q'SummQ Qhnf obtain Q'' where Q'Q''eqQ: "Q'  Q'' e Q" 
                                   and Q''Summ: "summands Q'' = summands Q - {Q'' |Q''. Q''  summands Q  Q'' e Q'}"
                                   and Q''hnf: "uhnf Q''"
      by(blast dest: pullSummand) 
    
    have FeqP'': "F = summands P''"
    proof -
      have "P'  F" by fact
      with P''Summ PSumm hnfSummandsRemove[OF P'SummP Phnf] show ?thesis by blast
    qed

    moreover have "P'  summands P''. Q'  summands Q''. P' e Q'"
    proof(rule ballI)
      fix P'''
      assume P'''Summ: "P'''  summands P''"
      with P''Summ have "P'''  summands P" by simp
      with PeqQ obtain Q''' where Q'''Summ: "Q'''  summands Q" and P'''eqQ''': "P''' e Q'''" by blast
      have "Q'''  summands Q''"
      proof -
        from P'''Summ P''Summ have "¬(P''' e P')" by simp
        with P'eqQ' P'''eqQ''' have "¬(Q''' e Q')"  by(blast intro: Trans Sym)
        with Q''Summ Q'''Summ show ?thesis by simp
      qed
    
      with P'''eqQ''' show "Q'summands Q''. P''' e Q'" by blast
    qed
    
    moreover have "Q'  summands Q''. P'  summands P''. Q' e P'"
    proof(rule ballI)
      fix Q'''
      assume Q'''Summ: "Q'''  summands Q''"
      with Q''Summ have "Q'''  summands Q" by simp
      with QeqP obtain P''' where P'''Summ: "P'''  summands P"
                              and Q'''eqP''': "Q''' e P'''" by blast
      have "P'''  summands P''"
      proof -
        from Q'''Summ Q''Summ have "¬(Q''' e Q')" by simp
        with P'eqQ' Q'''eqP''' have "¬(P''' e P')"  by(blast intro: Trans)
        with P''Summ P'''Summ show ?thesis by simp
      qed
      with Q'''eqP''' show "P'summands P''. Q''' e P'" by blast
    qed
    
    ultimately have P''eqQ'': "P'' e Q''" using P''hnf Q''hnf by(rule_tac IH) 
    
    from P'P''eqP have "P e P'  P''" by(rule Sym)
    moreover from P'eqQ' P''eqQ'' have "P'  P'' e Q'  Q''" by(rule SumPres')
    ultimately show ?case using Q'Q''eqQ by(blast intro: Trans)
  qed
qed


lemma validSubst[simp]:
  fixes P :: pi
  and   a :: name
  and   b :: name
  and   p :: pi
  
  shows "valid(P[a::=b]) = valid P"
by(nominal_induct P avoiding: a b rule: pi.strong_inducts, auto)

lemma validOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes "P a[b]  P'" 
  and     "valid P"

  shows "valid P'"
using assms
by(nominal_induct rule: outputInduct, auto)

lemma validInputTransition:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi

  assumes PTrans: "P a<x>  P'" 
  and     validP: "valid P"

  shows "valid P'"
proof -
  have Goal: "P a x P'. P a<x>  P'; x  P; valid P  valid P'"
  proof -
    fix P a x P'
    assume "P a<x>  P'" and "x  P" and "valid P"
    thus "valid P'"
      by(nominal_induct rule: inputInduct, auto)
  qed
  obtain y::name where yFreshP: "y  P" and yFreshP': "y  P'"
    by(rule_tac name_exists_fresh[of "(P, P')"], auto simp add: fresh_prod)
  from yFreshP' PTrans have "P a<y>  [(x, y)]  P'" by(simp add: alphaBoundResidual)
  hence "valid ([(x, y)]  P')" using yFreshP validP by(rule Goal)
  thus "valid P'" by simp
qed

lemma validBoundOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi

  assumes PTrans: "P ax>  P'" 
  and     validP: "valid P"

  shows "valid P'"
proof -
  have Goal: "P a x P'. P ax>  P'; x  P; valid P  valid P'"
  proof -
    fix P a x P'
    assume "P ax>  P'" and "x  P" and "valid P"
    thus "valid P'"
      apply(nominal_induct rule: boundOutputInduct, auto)
      proof -
        fix P a x P'
        assume "P (a::name)[x]  P'" and "valid P"
        thus "valid P'"
          by(nominal_induct rule: outputInduct, auto)
      qed
  qed
  obtain y::name where yFreshP: "y  P" and yFreshP': "y  P'"
    by(rule_tac name_exists_fresh[of "(P, P')"], auto simp add: fresh_prod)
  from yFreshP' PTrans have "P ay>  [(x, y)]  P'" by(simp add: alphaBoundResidual)
  hence "valid ([(x, y)]  P')" using yFreshP validP by(rule Goal)
  thus "valid P'" by simp
qed

lemma validTauTransition:
  fixes P  :: pi
  and   P' :: pi

  assumes PTrans: "P τ  P'"
  and     validP: "valid P"

  shows "valid P'"
using assms
by(nominal_induct rule: tauInduct, auto dest: validOutputTransition validInputTransition validBoundOutputTransition)

lemmas validTransition = validInputTransition validOutputTransition validTauTransition validBoundOutputTransition

lemma validSummand:
  fixes P  :: pi
  and   P' :: pi
  and   a  :: name
  and   b  :: name
  and   x  :: name

  assumes "valid P"
  and     "hnf P"

  shows "τ.(P')  summands P  valid P'"
  and   "a{b}.P'  summands P  valid P'"
  and   "a<x>.P'  summands P  valid P'"
  and   "a  x; x>a{x}.P'  summands P  valid P'"
proof -
  assume "τ.(P')  summands P"
  with assms show "valid P'" by(force intro: validTauTransition simp add: summandTransition)
next
  assume "a{b}.P'  summands P"
  with assms show "valid P'" by(force intro: validOutputTransition simp add: summandTransition)
next
  assume "a<x>.P'  summands P"
  with assms show "valid P'" by(force intro: validInputTransition simp add: summandTransition)
next
  assume "x>a{x}.P'  summands P" and "a  x"
  with assms show "valid P'" 
    by(force intro: validBoundOutputTransition simp add: summandTransition[THEN sym])
qed

lemma validExpand:
  fixes P :: pi
  and   Q :: pi

  assumes "valid P"
  and     "valid Q"
  and     "uhnf P"
  and     "uhnf Q"

  shows "R  (expandSet P Q). uhnf R  valid R"
proof -
  from assms have "hnf P" and "hnf Q" by(simp add: uhnf_def)+
  with assms show ?thesis
    apply(auto simp add: expandSet_def)
    apply(force dest: validSummand simp add: uhnf_def)
    apply(force dest: validSummand)
    apply(force dest: validSummand simp add: uhnf_def)
    apply(force dest: validSummand)
    apply(force dest: validSummand simp add: uhnf_def)
    apply(force dest: validSummand)
    apply(force dest: validSummand simp add: uhnf_def)
    apply(force dest: validSummand)
    apply(force dest: validSummand simp add: uhnf_def)
    apply(force dest: validSummand)
    apply(force dest: validSummand simp add: uhnf_def)
    apply(force dest: validSummand)
    apply(subgoal_tac "ax")
    apply(force dest: validSummand simp add: uhnf_def)
    apply blast
    apply(subgoal_tac "ax")
    apply(drule_tac validSummand(4)) apply assumption+
    apply blast
    apply(subgoal_tac "ax")
    apply(drule_tac validSummand(4)[where P=Q]) apply assumption+
    apply(force dest: validSummand simp add: uhnf_def)
    apply blast
    apply(subgoal_tac "ax")
    apply(drule_tac validSummand(4)[where P=Q]) apply assumption+
    apply blast
    apply(force dest: validSummand simp add: uhnf_def)
    apply(force dest: validSummand)
    apply(force dest: validSummand simp add: uhnf_def)
    apply(force simp add: uhnf_def)
    apply(force dest: validSummand)
    apply(force dest: validSummand)
    apply(force simp add: uhnf_def)
    apply(force dest: validSummand)
    apply(subgoal_tac "ay")
    apply(drule_tac validSummand(4)[where P=Q]) apply assumption+
    apply blast
    apply(force dest: validSummand simp add: uhnf_def)
    apply(subgoal_tac "ay")
    apply(drule_tac validSummand(4)) apply assumption+
    apply blast
    by(force dest: validSummand)
qed

lemma expandComplete:
  fixes F :: "pi set"

  assumes "finite F"

  shows "P. (P, F)  sumComposeSet"
using assms
proof(induct F rule: finite_induct)
  case empty
  have "(𝟬, {})  sumComposeSet" by(rule sumComposeSet.empty)
  thus ?case by blast
next
  case(insert Q F)
  have "P. (P, F)  sumComposeSet" by fact
  then obtain P where "(P, F)  sumComposeSet" by blast
  moreover have "Q  insert Q F" by simp
  moreover have "Q  F" by fact
  ultimately have "(P  Q, insert Q F)  sumComposeSet"
    by(force intro: sumComposeSet.insert)
  thus ?case by blast
qed

lemma expandDepth:
  fixes F :: "pi set"
  and   P :: pi
  and   Q :: pi

  assumes "(P, F)  sumComposeSet"
  and     "F  {}"

  shows "Q  F. depth P  depth Q  (R  F. depth R  depth Q)"
using assms
proof(induct arbitrary: Q rule: sumComposeSet.induct)
  case empty
  have "({}::pi set)  {}" by fact
  hence False by simp
  thus ?case by simp
next
  case(insert Q S P)
  have QinS: "Q  S" by fact
  show ?case
  proof(case_tac "(S - {Q}) = {}")
    assume "(S - {Q}) = {}"
    with QinS have SeqQ: "S = {Q}" by auto
    have "(P, S - {Q})  sumComposeSet" by fact
    with SeqQ have "(P, {})  sumComposeSet" by simp
    hence "P = 𝟬" apply - by(ind_cases "(P, {})  sumComposeSet", auto)
    with QinS SeqQ show ?case by simp
  next
    assume "(S - {Q})  {}"
    moreover have "(S - {Q})  {}  Q'  (S - {Q}). depth P  depth Q'  (R  (S - {Q}). depth R  depth Q')" by fact
    ultimately obtain Q' where Q'inS: "Q'  S - {Q}" and PQ'depth: "depth P  depth Q'" and All: "R  (S - {Q}). depth R  depth Q'" by auto
    show ?case
    proof(case_tac "Q = Q'")
      assume "Q = Q'"
      with PQ'depth All QinS show ?case by auto
    next
      assume QineqQ': "Q  Q'"
      show ?case
      proof(case_tac "depth Q  depth Q'")
        assume "depth Q  depth Q'"
        with QineqQ' PQ'depth All Q'inS show ?thesis by force
      next
        assume "¬ depth Q  depth Q'"
        with QineqQ' PQ'depth All Q'inS QinS show ?thesis apply auto
          apply(rule_tac x=Q in bexI)
          apply auto
          apply(case_tac "R=Q")
          apply auto
          apply(erule_tac x=R in ballE)
          by auto
      qed
    qed
  qed
qed

lemma depthSubst[simp]:
  fixes P :: pi
  and   a :: name
  and   b :: name

  shows "depth(P[a::=b]) = depth P"
by(nominal_induct P avoiding: a b rule: pi.strong_inducts, auto)

lemma depthTransition:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes Phnf: "hnf P"

  shows "P a[b]  P'  depth P' < depth P"
  and   "P a<x>  P'  depth P' < depth P"
  and   "P τ  P'  depth P' < depth P"
  and   "P ax>  P'  depth P' < depth P"
proof -
  assume "P a[b]  P'"
  thus "depth P' < depth P" using assms
    by(nominal_induct rule: outputInduct, auto)
next
  assume Trans: "P a<x>  P'"
  have Goal: "P a x P'. P a<x>  P'; x  P; hnf P  depth P' < depth P"
  proof -
    fix P a x P'
    assume "P a<x>  P'" and "x  P" and "hnf P"
    thus "depth P' < depth P"
      by(nominal_induct rule: inputInduct, auto)
  qed
  obtain y::name where yFreshP: "y  P" and yFreshP': "y  P'"
    by(rule_tac name_exists_fresh[of "(P, P')"], auto simp add: fresh_prod)
  from yFreshP' Trans have "P a<y>  [(x, y)]  P'" by(simp add: alphaBoundResidual)
  hence "depth ([(x, y)]  P') < depth P" using yFreshP Phnf by(rule Goal)
  thus "depth P' < depth P" by simp
next
  assume "P τ  P'"
  thus "depth P' < depth P" using assms
    by(nominal_induct rule: tauInduct, auto simp add: uhnf_def)
next
  assume Trans: "P ax>  P'"
  have Goal: "P a x P'. P ax>  P'; x  P; hnf P  depth P' < depth P"
  proof -
    fix P a x P'
    assume "P ax>  P'" and "x  P" and "hnf P"
    thus "depth P' < depth P"
      by(nominal_induct rule: boundOutputInduct,
         auto elim: outputCases simp add: residual.inject)
  qed
  obtain y::name where yFreshP: "y  P" and yFreshP': "y  P'"
    by(rule_tac name_exists_fresh[of "(P, P')"], auto simp add: fresh_prod)
  from yFreshP' Trans have "P ay>  [(x, y)]  P'" by(simp add: alphaBoundResidual)
  hence "depth ([(x, y)]  P') < depth P" using yFreshP Phnf by(rule Goal)
  thus "depth P' < depth P" by simp
qed

lemma maxExpandDepth:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  
  assumes "R  expandSet P Q"
  and     "hnf P"
  and     "hnf Q"

  shows "depth R  depth(P  Q)"
using assms
apply(auto simp add: expandSet_def summandTransition[THEN sym] dest: depthTransition)
apply(subgoal_tac "a  x")
apply(simp add: summandTransition[THEN sym])
apply(force dest: depthTransition)
apply blast
apply(subgoal_tac "a  x")
apply(simp add: summandTransition[THEN sym])
apply(force dest: depthTransition)
apply blast
apply(force dest: depthTransition)
apply(force dest: depthTransition)
apply(subgoal_tac "a  y")
apply(simp add: summandTransition[THEN sym])
apply(force dest: depthTransition)
apply blast
apply(subgoal_tac "a  y")
apply(simp add: summandTransition[THEN sym])
apply(force dest: depthTransition)
by blast

lemma expandDepth':
  fixes P :: pi
  and   Q :: pi

  assumes Phnf: "hnf P"
  and     Qhnf: "hnf Q"

  shows "R. (R, expandSet P Q)  sumComposeSet  depth R  depth(P  Q)"
proof(case_tac "expandSet P Q = {}")
  assume "expandSet P Q = {}"
  with Phnf Qhnf show ?thesis by(auto intro: sumComposeSet.empty)
next
  assume "expandSet P Q  {}"

  moreover from Phnf Qhnf finiteExpand obtain R where TSC: "(R, expandSet P Q)  sumComposeSet"
    by(blast dest: expandComplete)
  ultimately obtain T where "T  expandSet P Q"
                        and "depth R  depth T"
    by(blast dest: expandDepth)
  with Phnf Qhnf have "depth R  depth(P  Q)"
    by(force dest: maxExpandDepth)
  with TSC show ?thesis by blast
qed

lemma validToHnf:
  fixes P :: pi

  assumes "valid P"

  shows "Q. uhnf Q  valid Q  Q e P  (depth Q)  (depth P)"
proof -
  have MatchGoal: "a b P Q. uhnf Q; valid Q; Q e P; depth Q  depth P 
                               Q. uhnf Q  valid Q  Q e [ab]P  depth Q  depth ([ab]P)"
  proof -
    fix a b P Q
    assume Qhnf: "uhnf Q" and validQ: "valid Q" and QeqP: "Q e P"
       and QPdepth: "depth Q  depth P"
    show "Q. uhnf Q  valid Q  Q e [ab]P  depth Q  depth ([ab]P)"
    proof(case_tac "a = b")
      assume "a = b"
      with QeqP have "Q e [ab]P" by(blast intro: Sym Trans equiv.Match)
      with Qhnf validQ QPdepth show ?thesis by force
    next
      assume "a  b"
      hence "𝟬 e [ab]P" by(blast intro: Sym Match')
      moreover have "uhnf 𝟬" by(simp add: uhnf_def)
      ultimately show ?thesis by force
    qed
  qed
  
  from assms show ?thesis
  proof(nominal_induct P rule: pi.strong_inducts)
    case PiNil
    have "uhnf 𝟬" by(simp add: uhnf_def)
    moreover have "valid 𝟬" by simp
    moreover have "𝟬 e 𝟬" by(rule Refl)
    moreover have "(depth 𝟬)  (depth 𝟬)" by simp
    ultimately show ?case by blast
  next
    case(Output a b P)
    have "uhnf (a{b}.P)" by(simp add: uhnf_def)
    moreover have "valid(a{b}.P)" by fact
    moreover have "a{b}.P e a{b}.P" by(rule Refl)
    moreover have "(depth (a{b}.P))  (depth (a{b}.P))" by simp
    ultimately show ?case by blast
  next
    case(Tau P)
    have "uhnf (τ.(P))" by(simp add: uhnf_def)
    moreover have "valid (τ.(P))" by fact
    moreover have "τ.(P) e τ.(P)" by(rule Refl)
    moreover have "(depth (τ.(P)))  (depth (τ.(P)))" by simp
    ultimately show ?case by blast
  next
    case(Input a x P)
    have "uhnf (a<x>.P)" by(simp add: uhnf_def)
    moreover have "valid (a<x>.P)" by fact
    moreover have "a<x>.P e a<x>.P" by(rule Refl)
    moreover have "(depth (a<x>.P))  (depth (a<x>.P))" by simp
    ultimately show ?case by blast
  next
    case(Match a b P)
    have "valid ([ab]P)" by fact
    hence "valid P" by simp
    moreover have "valid P  Q. uhnf Q  valid Q  Q e P  depth Q  depth P" by fact
    ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q" and QeqP: "Q e P" 
                          and QPdepth: "depth Q  depth P" by blast
    thus ?case by(rule MatchGoal)
  next
    case(Mismatch a b P)
    have "valid ([ab]P)" by fact
    hence "valid P" by simp
    moreover have "valid P  Q. uhnf Q  valid Q  Q e P  depth Q  depth P" by fact
    ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q" and QeqP: "Q e P" 
                          and QPdepth: "depth Q  depth P" by blast
    show ?case
    proof(case_tac "a = b")
      assume "a = b"
      hence "𝟬 e [ab]P" by(blast intro: Sym Mismatch')
      moreover have "uhnf 𝟬" by(simp add: uhnf_def)
      ultimately show ?case by force
    next
      assume "a  b"
      with QeqP have "Q e [ab]P" by(blast intro: Sym Trans equiv.Mismatch)
      with Qhnf validQ QPdepth show ?case by force
    qed
  next
    case(Sum P Q)
    have "valid(P  Q)" by fact
    hence validP: "valid P" and validQ: "valid Q" by simp+
    
    have "P'. uhnf P'  valid P'  P' e P  (depth P')  (depth P)"
    proof -
      have "valid P  P'. uhnf P'  valid P'  P' e P  (depth P')  (depth P)" by fact
      with validP show ?thesis by simp
    qed
    then obtain P' where P'hnf: "uhnf P'" and P'eqP: "P' e P" and validP': "valid P'"
                     and P'depth: "(depth P')  (depth P)" by blast

    have "Q'. uhnf Q'  valid Q'  Q' e Q  (depth Q')  (depth Q)"
    proof -
      have "valid Q  Q'. uhnf Q'  valid Q'  Q' e Q  (depth Q')  (depth Q)" by fact
      with validQ show ?thesis by simp
    qed
    
    then obtain Q' where Q'hnf: "uhnf Q'" and Q'eqQ: "Q' e Q" and validQ': "valid Q'"
                     and Q'depth: "(depth Q')  (depth Q)" by blast    
      
    from P'hnf Q'hnf validP' validQ' obtain R where Rhnf: "uhnf R" and validR: "valid R"
                                              and P'Q'eqR: "P'  Q' e R"
                                              and Rdepth: "depth R  depth(P'  Q')"
      apply(drule_tac uhnfSum) apply assumption+ by blast
    
    from validP' validQ' have "valid(P'  Q')" by simp
    from P'eqP Q'eqQ P'Q'eqR have "P  Q e R" by(blast intro: Sym SumPres' Trans)
    moreover from Rdepth P'depth Q'depth have "depth R  depth(P  Q)" by auto
    ultimately show ?case using validR Rhnf by(blast intro: Sym)
  next
    case(Par P Q)
    have "valid(P  Q)" by fact
    
    hence validP: "valid P" and validQ: "valid Q" by simp+
    have "P'. uhnf P'  valid P'  P' e P  (depth P')  (depth P)"
    proof -
      have "valid P  P'. uhnf P'  valid P'  P' e P  (depth P')  (depth P)" by fact
      with validP show ?thesis by simp
    qed
    then obtain P' where P'hnf: "uhnf P'" and P'eqP: "P' e P" and validP': "valid P'"
                     and P'depth: "(depth P')  (depth P)" by blast

    have "Q'. uhnf Q'  valid Q'  Q' e Q  (depth Q')  (depth Q)"
    proof -
      have "valid Q  Q'. uhnf Q'  valid Q'  Q' e Q  (depth Q')  (depth Q)" by fact
      with validQ show ?thesis by simp
    qed
    
    then obtain Q' where Q'hnf: "uhnf Q'" and Q'eqQ: "Q' e Q" and validQ': "valid Q'"
                     and Q'depth: "(depth Q')  (depth Q)" by blast

    from P'hnf Q'hnf obtain R where Exp: "(R, expandSet P' Q')  sumComposeSet" and Rdepth: "depth R  depth(P'  Q')"
      by(force dest: expandDepth' simp add: uhnf_def)
    
    from Exp P'hnf Q'hnf have P'Q'eqR: "P'  Q' e R" by(force intro: Expand simp add: uhnf_def)
    from P'hnf Q'hnf validP' validQ' have "P  (expandSet P' Q'). uhnf P  valid P" by(blast dest: validExpand)
    with Exp obtain R' where R'hnf: "uhnf R'" and validR': "valid R'"
                                              and ReqR': "R e R'"
                                              and R'depth: "depth R'  depth R"
      by(blast dest: expandHnf)
    from P'eqP Q'eqQ P'Q'eqR ReqR' have "P  Q e R'" by(blast intro: Sym ParPres Trans)
    moreover from Rdepth P'depth Q'depth R'depth have "depth R'  depth(P  Q)" by auto
    ultimately show ?case using validR' R'hnf by(blast dest: Sym)
  next
    case(Res x P)
    have "valid (x>P)" by fact
    hence validP: "valid P" by simp
    moreover have "valid P  Q. uhnf Q  valid Q  Q e P  depth Q  depth P" by fact
    ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q" and QeqP: "Q e P"
                          and QPDepth: "depth Q  depth P" by blast
    
    from validP show ?case
    proof(nominal_induct P avoiding: x rule: pi.strong_inducts)
      case PiNil
      have "uhnf 𝟬" by(simp add: uhnf_def)
      moreover have "valid 𝟬" by simp
      moreover have "𝟬 e x>𝟬"
      proof -
        have "x  𝟬" by simp
        thus ?thesis by(blast intro: Sym ResFresh)
      qed
      moreover have "depth 𝟬  depth (x>𝟬)" by simp
      ultimately show ?case by blast
    next
      case(Output a b P)
      have "valid(a{b}.P)" by fact
      hence validP: "valid P" by simp
      show ?case
      proof(case_tac "x=a")
        assume "x = a"
        moreover have "uhnf 𝟬" by(simp add: uhnf_def)
        moreover have "valid 𝟬" by simp
        moreover have "𝟬 e x>x{b}.P" by(blast intro: ResOutput' Sym)
        moreover have "depth 𝟬  depth(x>x{b}.P)" by simp
        ultimately show ?case by blast
      next
        assume xineqa: "x  a"
        show ?case
        proof(case_tac "x=b")
          assume "x=b"
          moreover from xineqa have "uhnf(x>a{x}.P)" by(force simp add: uhnf_def)
          moreover from validP have "valid(x>a{x}.P)" by simp
          moreover have "x>a{x}.P e x>a{x}.P" by(rule Refl)
          moreover have "depth(x>a{x}.P)  depth(x>a{x}.P)" by simp
          ultimately show ?case by blast
        next
          assume xineqb: "x  b"
          have "uhnf(a{b}.(x>P))" by(simp add: uhnf_def)
          moreover from validP have "valid(a{b}.(x>P))" by simp
          moreover from xineqa xineqb have "a{b}.(x>P) e x>a{b}.P" by(blast intro: ResOutput Sym)
          moreover have "depth(a{b}.(x>P))  depth(x>a{b}.P)" by simp
          ultimately show ?case by blast
        qed
      qed
    next
      case(Tau P)
      have "valid(τ.(P))" by fact
      hence validP: "valid P" by simp
      
      have "uhnf(τ.(x>P))" by(simp add: uhnf_def)
      moreover from validP have "valid(τ.(x>P))" by simp
      moreover have "τ.(x>P) e x>τ.(P)" by(blast intro: ResTau Sym)
      moreover have "depth(τ.(x>P))  depth(x>τ.(P))" by simp
      ultimately show ?case by blast
    next
      case(Input a y P)
      have "valid(a<y>.P)" by fact
      hence validP: "valid P" by simp
      have "y  x" by fact hence yineqx: "y  x" by simp
      show ?case
      proof(case_tac "x=a")
        assume "x = a"
        moreover have "uhnf 𝟬" by(simp add: uhnf_def)
        moreover have "valid 𝟬" by simp
        moreover have "𝟬 e x>x<y>.P" by(blast intro: ResInput' Sym)
        moreover have "depth 𝟬  depth(x>x<y>.P)" by simp
        ultimately show ?case by blast
      next
        assume xineqa: "x  a"
        have "uhnf(a<y>.(x>P))" by(simp add: uhnf_def)
        moreover from validP have "valid(a<y>.(x>P))" by simp
        moreover from xineqa yineqx have "a<y>.(x>P) e x>a<y>.P" by(blast intro: ResInput Sym)
        moreover have "depth(a<y>.(x>P))  depth(x>a<y>.P)" by simp
        ultimately show ?case by blast
      qed
    next
      case(Match a b P x)
      have "valid([ab]P)" by fact hence "valid P" by simp
      moreover have "x. valid P  Q. uhnf Q  valid Q  Q e x>P  
                                           depth Q  depth(x>P)"
        by fact
      ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q"
                            and QeqP: "Q e (x>P)" 
                            and QPdepth: "depth Q  depth(x>P)"
        by blast
      show ?case
      proof(case_tac "a = b")
        assume "a=b"
        moreover have "Q e x>[aa]P"
        proof -
          have "P e [aa]P" by(blast intro: equiv.Match Sym)
          hence "x>P e x>[aa]P" by(rule ResPres)
          with QeqP show ?thesis by(blast intro: Trans)
        qed
        moreover from QPdepth have "depth Q  depth(x>[aa]P)" by simp
        ultimately show ?case using Qhnf validQ by blast
      next
        assume aineqb: "ab"
        have "uhnf 𝟬" by(simp add: uhnf_def)
        moreover have "valid 𝟬" by simp
        moreover have "𝟬 e x>[ab]P"
        proof -
          from aineqb have "𝟬 e [ab]P" by(blast intro: Match' Sym)
          hence "x>𝟬 e x>[ab]P" by(rule ResPres)
          thus ?thesis by(blast intro: ResNil Trans Sym)
        qed
        moreover have "depth 𝟬  depth(x>[ab]P)" by simp
        ultimately show ?case by blast
      qed
    next
      case(Mismatch a b P x)
      have "valid([ab]P)" by fact hence "valid P" by simp
      moreover have "x. valid P  Q. uhnf Q  valid Q  Q e x>P  
                                           depth Q  depth(x>P)"
        by fact
      ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q"
                            and QeqP: "Q e (x>P)" 
                            and QPdepth: "depth Q  depth(x>P)"
        by blast
      show ?case
      proof(case_tac "a = b")
        assume "a=b"
        moreover have "uhnf 𝟬" by(simp add: uhnf_def)
        moreover have "valid 𝟬" by simp
        moreover have "𝟬 e x>[aa]P"
        proof -
          have "𝟬 e [aa]P" by(blast intro: Mismatch' Sym)
          hence "x>𝟬 e x>[aa]P" by(rule ResPres)
          thus ?thesis by(blast intro: ResNil Trans Sym)
        qed
        moreover have "depth 𝟬  depth(x>[aa]P)" by simp
        ultimately show ?case by blast
      next
        assume aineqb: "ab"
        have "Q e x>[ab]P"
        proof -
          from aineqb have "P e [ab]P" by(blast intro: equiv.Mismatch Sym)
          hence "x>P e x>[ab]P" by(rule ResPres)
          with QeqP show ?thesis by(blast intro: Trans)
        qed
        moreover from QPdepth have "depth Q  depth(x>[ab]P)" by simp
        ultimately show ?case using Qhnf validQ by blast
      qed
    next
      case(Sum P Q x)
      have "valid(P  Q)" by fact
      hence validP: "valid P" and validQ: "valid Q" by simp+

      have "P'. uhnf P'  valid P'  P' e x>P  (depth P')  (depth(x>P))"
      proof -
        have "valid P  P'. uhnf P'  valid P'  P' e x>P  (depth P')  (depth (x>P))" by fact
        with validP show ?thesis by simp
      qed
      then obtain P' where P'hnf: "uhnf P'" and P'eqP: "P' e x>P" and validP': "valid P'"
                       and P'depth: "(depth P')  (depth(x>P))" by blast

      have "Q'. uhnf Q'  valid Q'  Q' e x>Q  (depth Q')  (depth(x>Q))"
      proof -
        have "valid Q  Q'. uhnf Q'  valid Q'  Q' e x>Q  (depth Q')  (depth(x>Q))" by fact
        with validQ show ?thesis by simp
      qed

      then obtain Q' where Q'hnf: "uhnf Q'" and Q'eqQ: "Q' e x>Q" and validQ': "valid Q'"
                       and Q'depth: "(depth Q')  (depth(x>Q))" by blast    
      
      from P'hnf Q'hnf validP' validQ' obtain R where Rhnf: "uhnf R" and validR: "valid R"
                                                and P'Q'eqR: "P'  Q' e R"
                                                and Rdepth: "depth R  depth(P'  Q')"
        apply(drule_tac uhnfSum) apply assumption+ by blast
      
      from P'eqP Q'eqQ P'Q'eqR have "x>(P  Q) e R" by(blast intro: Sym SumPres' SumRes Trans)
      moreover from Rdepth P'depth Q'depth have "depth R  depth(x>(P  Q))" by auto
      ultimately show ?case using validR Rhnf by(blast intro: Sym)
    next
      case(Par P Q x)
      have "valid(P  Q)" by fact
      
      hence validP: "valid P" and validQ: "valid Q" by simp+
      have "P'. uhnf P'  valid P'  P' e P  (depth P')  (depth P)"
      proof -
        obtain x::name where xFreshP: "x  P" by(rule name_exists_fresh)
        moreover have "x. valid P  P'. uhnf P'  valid P'  P' e (x>P)  (depth P')  (depth(x>P))" by fact
        with validP obtain P' where "uhnf P'" and "valid P'" and P'eqP: "P' e (x>P)" and P'depth: "(depth P')  (depth(x>P))" by blast
        moreover from xFreshP P'eqP have "P' e P" by(blast intro: Trans ResFresh)
        moreover with P'depth have "depth P'  depth P" by simp
        ultimately show ?thesis by blast
      qed

      then obtain P' where P'hnf: "uhnf P'" and P'eqP: "P' e P" and validP': "valid P'"
                       and P'depth: "(depth P')  (depth P)" by blast

      have "Q'. uhnf Q'  valid Q'  Q' e Q  (depth Q')  (depth Q)"
      proof -
        obtain x::name where xFreshQ: "x  Q" by(rule name_exists_fresh)
        moreover have "x. valid Q  Q'. uhnf Q'  valid Q'  Q' e (x>Q)  (depth Q')  (depth(x>Q))" by fact
        with validQ obtain Q' where "uhnf Q'" and "valid Q'" and Q'eqQ: "Q' e (x>Q)" and Q'depth: "(depth Q')  (depth(x>Q))" by blast
        moreover from xFreshQ Q'eqQ have "Q' e Q" by(blast intro: Trans ResFresh)
        moreover with Q'depth have "depth Q'  depth Q" by simp
        ultimately show ?thesis by blast
      qed
      
      then obtain Q' where Q'hnf: "uhnf Q'" and Q'eqQ: "Q' e Q" and validQ': "valid Q'"
                       and Q'depth: "(depth Q')  (depth Q)" by blast
      
      from P'hnf Q'hnf obtain R where Exp: "(R, expandSet P' Q')  sumComposeSet" and Rdepth: "depth R  depth(P'  Q')"
        by(force dest: expandDepth' simp add: uhnf_def)
    
      from Exp P'hnf Q'hnf have P'Q'eqR: "P'  Q' e R" by(force intro: Expand simp add: uhnf_def)
      from P'hnf Q'hnf validP' validQ' have "P  (expandSet P' Q'). uhnf P  valid P" by(blast dest: validExpand)
      with Exp obtain R' where R'hnf: "uhnf R'" and validR': "valid R'"
                                                and ReqR': "R e R'"
                                                and R'depth: "depth R'  depth R"
        by(blast dest: expandHnf)
      
      from P'eqP Q'eqQ P'Q'eqR ReqR' have "P  Q e R'" by(blast intro: Sym ParPres Trans)
      hence ResTrans: "x>(P  Q) e x>R'" by(rule ResPres)
      from validR' R'hnf obtain R'' where R''hnf: "uhnf R''" and validR'': "valid R''" and R'eqR'': "x>R' e R''" and R''depth: "depth R''  depth(x>R')"
        by(force dest: uhnfRes)
      from ResTrans R'eqR'' have "x>(P  Q) e R''" by(rule Trans)
      moreover from Rdepth P'depth Q'depth R'depth R''depth have "depth R''  depth(x>(P  Q))" by auto
      ultimately show ?case using validR'' R''hnf by(blast dest: Sym)
    next
      case(Res y P x)
      have "valid(y>P)" by fact hence "valid P" by simp
      moreover have "x. valid P  Q. uhnf Q  valid Q  Q e x>P  depth Q  depth(x>P)"
        by fact
      ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q" and QeqP: "Q e y>P"
                            and QPdepth: "depth Q  depth(y>P)" by blast

      from Qhnf validQ obtain Q' where Q'hnf: "uhnf Q'" and validQ': "valid Q'" and QeqQ': "x>Q e Q'"
                                   and Q'Qdepth: "depth Q'  depth(x>Q)"
        by(force dest: uhnfRes)

      from QeqP have "x>Q e x>y>P" by(rule ResPres)
      with QeqQ' have "Q' e x>y>P" by(blast intro: Trans Sym)
      moreover from Q'Qdepth QPdepth have "depth Q'  depth(x>y>P)" by simp
      ultimately show ?case using Q'hnf validQ' by blast
    next
      case(Bang P x)
      have "valid(!P)" by fact
      hence False by simp
      thus ?case by simp
    qed
  next
    case(Bang P)
    have "valid(!P)" by fact
    hence False by simp
    thus ?case by simp
  qed
qed

lemma depthZero:
  fixes P :: pi
  
  assumes "depth P = 0"
  and     "uhnf P"

  shows "P = 𝟬"
using assms
apply(nominal_induct P rule: pi.strong_inducts, auto simp add: uhnf_def max_def if_split) 
apply(case_tac "depth pi1  depth pi2")
by auto

lemma completeAux:
  fixes n :: nat
  and   P :: pi
  and   Q :: pi

  assumes "depth P + depth Q  n"
  and     "valid P"
  and     "valid Q"
  and     "uhnf P"
  and     "uhnf Q"
  and     "P  Q"

  shows "P e Q"
using assms
proof(induct n arbitrary: P Q rule: nat.induct)
  case(zero P Q)
  have "depth P + depth Q  0" by fact
  hence Pdepth: "depth P = 0" and Qdepth: "depth Q = 0" by auto
  moreover have  "uhnf P" and "uhnf Q" by fact+
  ultimately have "P = 𝟬" and "Q = 𝟬" by(blast intro: depthZero)+
  thus ?case by(blast intro: Refl)
next
  case(Suc n P Q)
  have validP: "valid P" and validQ: "valid Q" by fact+
  have Phnf: "uhnf P" and Qhnf: "uhnf Q" by fact+
  have PBisimQ: "P  Q" by fact
  have IH: "P Q. depth P + depth Q  n; valid P; valid Q; uhnf P; uhnf Q; P  Q  P e Q"
    by fact
  have PQdepth: "depth P + depth Q  Suc n" by fact
  
  have Goal: "P Q Q'. depth P + depth Q  Suc n; valid P; valid Q; uhnf P; uhnf Q; 
                        P ↝[bisim] Q; Q'  summands Q  P'  summands P. Q' e P'"
  proof -
    fix P Q Q'
    assume PQdepth: "depth P + depth Q  Suc n"
    assume validP: "valid P" and validQ: "valid Q"
    assume Phnf: "uhnf P" and Qhnf: "uhnf Q"
    assume PSimQ: "P ↝[bisim] Q"
    assume Q'inQ: "Q'  summands Q"
    
    thus "P'  summands P. Q' e P'" using PSimQ Phnf validP PQdepth
    proof(nominal_induct Q' avoiding: P rule: pi.strong_inducts)
      case PiNil
      have "𝟬  summands Q" by fact
      hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split)
      thus ?case by simp
    next
      case(Output a b Q' P)
      have validP: "valid P" and Phnf: "uhnf P" and PSimQ: "P ↝[bisim] Q" by fact+
      have PQdepth: "depth P + depth Q  Suc n" by fact
      have "a{b}.Q'  summands Q" by fact
      with Qhnf have QTrans: "Q a[b]  Q'" by(simp add: summandTransition uhnf_def)
      with PSimQ obtain P' where PTrans: "P a[b]  P'" and P'BisimQ': "P'  Q'"
        by(blast dest: simE)
      
      from Phnf PTrans have "a{b}.P'  summands P" by(simp add: summandTransition uhnf_def)
      moreover have "P' e Q'"
      proof -
        from validP PTrans have validP': "valid P'" by(blast intro: validTransition)
        from validQ QTrans have validQ': "valid Q'" by(blast intro: validTransition)
        
        from validP' obtain P'' where P''hnf: "uhnf P''" and validP'': "valid P''"
                                  and P''eqP': "P'' e P'" and P''depth: "depth P''  depth P'"
          by(blast dest: validToHnf)
        
        from validQ' obtain Q'' where Q''hnf: "uhnf Q''" and validQ'': "valid Q''"
                                  and Q''eqQ': "Q'' e Q'" and Q''depth: "depth Q''  depth Q'"
          by(blast dest: validToHnf)
        
        have "depth P'' + depth Q''  n"
        proof -
          from Phnf PTrans have "depth P' < depth P" 
            by(force intro: depthTransition simp add: uhnf_def)
          moreover from Qhnf QTrans have "depth Q' < depth Q"
            by(force intro: depthTransition simp add: uhnf_def)
          ultimately show ?thesis using PQdepth P''depth Q''depth by simp
        qed
        
        moreover have "P''  Q''"
        proof -
          from P''eqP' have "P''  P'" by(rule sound)
          moreover from Q''eqQ' have "Q''  Q'" by(rule sound)
          ultimately show ?thesis using P'BisimQ' by(blast dest: transitive symmetric)
        qed
        ultimately have "P'' e Q''" using validP'' validQ'' P''hnf Q''hnf by(rule_tac IH)
        with P''eqP' Q''eqQ' show ?thesis by(blast intro: Sym Trans)
      qed
      ultimately show ?case by(blast intro: Sym equiv.OutputPres)
    next
      case(Tau Q' P)
      have validP: "valid P" and Phnf: "uhnf P" and PSimQ: "P ↝[bisim] Q" by fact+
      have PQdepth: "depth P + depth Q  Suc n" by fact
      have "τ.(Q')  summands Q" by fact
      with Qhnf have QTrans: "Q τ  Q'" by(simp add: summandTransition uhnf_def)
      with PSimQ obtain P' where PTrans: "P τ  P'" and P'BisimQ': "P'  Q'"
        by(blast dest: simE)
      
      from Phnf PTrans have "τ.(P')  summands P" by(simp add: summandTransition uhnf_def)
      moreover have "P' e Q'"
      proof -
        from validP PTrans have validP': "valid P'" by(blast intro: validTransition)
        from validQ QTrans have validQ': "valid Q'" by(blast intro: validTransition)
        
        from validP' obtain P'' where P''hnf: "uhnf P''" and validP'': "valid P''"
                                  and P''eqP': "P'' e P'" and P''depth: "depth P''  depth P'"
          by(blast dest: validToHnf)
          
        from validQ' obtain Q'' where Q''hnf: "uhnf Q''" and validQ'': "valid Q''"
                                  and Q''eqQ': "Q'' e Q'" and Q''depth: "depth Q''  depth Q'"
          by(blast dest: validToHnf)
        
        have "depth P'' + depth Q''  n"
        proof -
          from Phnf PTrans have "depth P' < depth P"
            by(force intro: depthTransition simp add: uhnf_def)
          moreover from Qhnf QTrans have "depth Q' < depth Q" 
            by(force intro: depthTransition simp add: uhnf_def)
          ultimately show ?thesis using PQdepth P''depth Q''depth by simp
        qed
        
        moreover have "P''  Q''"
        proof -
          from P''eqP' have "P''  P'" by(rule sound)
          moreover from Q''eqQ' have "Q''  Q'" by(rule sound)
          ultimately show ?thesis using P'BisimQ' by(blast dest: transitive symmetric)
        qed
        ultimately have "P'' e Q''" using validP'' validQ'' P''hnf Q''hnf by(rule_tac IH)
        with P''eqP' Q''eqQ' show ?thesis by(blast intro: Sym Trans)
      qed
      ultimately show ?case by(blast intro: Sym equiv.TauPres)
    next
      case(Input a x Q' P)
      have validP: "valid P" and Phnf: "uhnf P" and PSimQ: "P ↝[bisim] Q" and xFreshP: "x  P"  by fact+
      have PQdepth: "depth P + depth Q  Suc n" by fact
      have "a<x>.Q'  summands Q" by fact
      with Qhnf have QTrans: "Q a<x>  Q'" by(simp add: summandTransition uhnf_def)
      with PSimQ xFreshP obtain P' where PTrans: "P a<x>  P'"
                                     and P'derQ': "derivative P' Q' (InputS a) x bisim"
        by(blast dest: simE)

      from Phnf PTrans have "a<x>.P'  summands P" by(simp add: summandTransition uhnf_def)
      moreover have "y  supp(P', Q', x). P'[x::=y] e Q'[x::=y]"
      proof(rule ballI)
        fix y::name
        assume ysupp: "y  supp(P', Q', x)"
        have validP': "valid(P'[x::=y])"
        proof -
          from validP PTrans have validP': "valid P'" by(blast intro: validTransition)
          thus ?thesis by simp
        qed
        have validQ': "valid(Q'[x::=y])"
        proof -
          from validQ QTrans have validQ': "valid Q'" by(blast intro: validTransition)
          thus ?thesis by simp
        qed
        
        from validP' obtain P'' where P''hnf: "uhnf P''" and validP'': "valid P''"
                                  and P''eqP': "P'' e P'[x::=y]" and P''depth: "depth P''  depth(P'[x::=y])"
          by(blast dest: validToHnf)
        
        from validQ' obtain Q'' where Q''hnf: "uhnf Q''" and validQ'': "valid Q''"
                                  and Q''eqQ': "Q'' e Q'[x::=y]" and Q''depth: "depth Q''  depth(Q'[x::=y])"
          by(blast dest: validToHnf)
        
        have "depth P'' + depth Q''  n"
        proof -
          from Phnf PTrans have "depth P' < depth P"
            by(force intro: depthTransition simp add: uhnf_def)
          moreover from Qhnf QTrans have "depth Q' < depth Q" 
            by(force intro: depthTransition simp add: uhnf_def)
          ultimately show ?thesis using PQdepth P''depth Q''depth by simp 
        qed
          
        moreover have "P''  Q''"
        proof -
          from P'derQ' have P'BisimQ': "P'[x::=y]  Q'[x::=y]" 
            by(auto simp add: derivative_def)
          from P''eqP' have "P''  P'[x::=y]" by(rule sound)
          moreover from Q''eqQ' have "Q''  Q'[x::=y]" by(rule sound)
          ultimately show ?thesis using P'BisimQ' by(blast dest: transitive symmetric)
        qed
        ultimately have "P'' e Q''" using validP'' validQ'' P''hnf Q''hnf by(rule_tac IH)
        with P''eqP' Q''eqQ' show "P'[x::=y] e Q'[x::=y]" by(blast intro: Sym Trans)
      qed
      
      ultimately show ?case 
        apply -
        apply(rule_tac x="a<x>.P'" in bexI)
        apply(rule equiv.InputPres)
        apply(rule ballI)
        apply(erule_tac x=y in ballE)
        apply(blast dest: Sym)
        by(auto simp add: supp_prod)
    next
      case(Match a b P' P)
      have "[ab]P'  summands Q" by fact
      hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split)
      thus ?case by simp
    next
      case(Mismatch a b P' P)
      have "[ab]P'  summands Q" by fact
      hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split)
      thus ?case by simp
    next
      case(Sum P' Q' P)
      have "P'  Q'  summands Q" by fact
      hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split)
      thus ?case by simp
    next
      case(Par P' Q' P)
      have "P'  Q'  summands Q" by fact
      hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split)
      thus ?case by simp
    next
      case(Res x Q'' P)
      have xFreshP: "x  P" by fact
      have validP: "valid P" and Phnf: "uhnf P" and PSimQ: "P ↝[bisim] Q" by fact+
      have PQdepth: "depth P + depth Q  Suc n" by fact
      have Q''summQ: "x>Q''  summands Q" by fact
      hence "a Q'. a  x  Q'' = a{x}.Q'"
        by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split pi.inject name_abs_eq name_calc)  
      then obtain a Q' where aineqx: "a  x" and Q'eqQ'': "Q'' = a{x}.Q'"
        by blast
      with Qhnf  Q''summQ have QTrans: "Q ax>  Q'" by(simp add: summandTransition uhnf_def)
      with PSimQ xFreshP obtain P' where PTrans: "P ax>  P'" and P'BisimQ': "P'  Q'"
        by(force dest: simE simp add: derivative_def)
        
      from Phnf PTrans aineqx have "(x>a{x}.P')  summands P" by(simp add: summandTransition uhnf_def)
      moreover have "a{x}.P' e a{x}.Q'"
      proof -
        have "P' e Q'"
        proof -
          from validP PTrans have validP': "valid P'" by(blast intro: validTransition)
          from validQ QTrans have validQ': "valid Q'" by(blast intro: validTransition)
        
          from validP' obtain P'' where P''hnf: "uhnf P''" and validP'': "valid P''"
                                    and P''eqP': "P'' e P'" and P''depth: "depth P''  depth P'"
            by(blast dest: validToHnf)
          
          from validQ' obtain Q'' where Q''hnf: "uhnf Q''" and validQ'': "valid Q''"
                                    and Q''eqQ': "Q'' e Q'" and Q'''depth: "depth Q''  depth Q'"
            by(blast dest: validToHnf)
            
          have "depth P'' + depth Q''  n"
          proof -
            from Phnf PTrans have "depth P' < depth P"
              by(force intro: depthTransition simp add: uhnf_def)
            moreover from Qhnf QTrans have "depth Q' < depth Q" 
              by(force intro: depthTransition simp add: uhnf_def)
            ultimately show ?thesis using PQdepth P''depth Q'''depth by simp
          qed
            
          moreover have "P''  Q''"
          proof -
            from P''eqP' have "P''  P'" by(rule sound)
            moreover from Q''eqQ' have "Q''  Q'" by(rule sound)
            ultimately show ?thesis using P'BisimQ' by(blast dest: transitive symmetric)
          qed
          ultimately have "P'' e Q''" using validP'' validQ'' P''hnf Q''hnf by(rule_tac IH)
          with P''eqP' Q''eqQ' show ?thesis by(blast intro: Sym Trans)
        qed
        thus ?thesis by(rule OutputPres)
      qed
      ultimately show ?case using Q'eqQ'' by(blast intro: Sym equiv.ResPres)
    next
      case(Bang P' P)
      have "!P'  summands Q" by fact
      hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split) 
      thus ?case by simp
    qed
  qed

  from Phnf Qhnf PQdepth validP validQ PBisimQ show ?case
    apply(rule_tac summandEquiv, auto)
    apply(rule Goal)
    apply auto
    apply(blast dest: bisimE symmetric)
    by(blast intro: Goal dest: bisimE)
qed

lemma complete: 
  fixes P :: pi
  and   Q :: pi

  assumes validP: "valid P"
  and     validQ: "valid Q"
  and     PBisimQ: "P  Q"

  shows "P e Q"
proof -
  from validP obtain P' where validP': "valid P'" and P'hnf: "uhnf P'" and P'eqP: "P' e P"
    by(blast dest: validToHnf)
  from validQ obtain Q' where validQ': "valid Q'" and Q'hnf: "uhnf Q'" and Q'eqQ: "Q' e Q"
    by(blast dest: validToHnf)
  
  have "n. depth P' + depth Q'  n" by auto
  then obtain n where "depth P' + depth Q'  n" by blast
  moreover have "P'  Q'"
  proof -
    from P'eqP have "P'  P" by(rule sound)
    moreover from Q'eqQ have "Q'  Q" by(rule sound)
    ultimately show ?thesis using PBisimQ by(blast intro: symmetric transitive)
  qed
  ultimately have "P' e Q'" using validP' validQ' P'hnf Q'hnf by(rule_tac completeAux)
  with P'eqP Q'eqQ show ?thesis by(blast intro: Sym Trans)
qed

end